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POLICY: Pascal News (79/09/01) 

* Pascal News is the official but informal publication of the User's Group. 

Pascal News contains all we (the editors) know about Pascal; we use it as 
the vehicle to answer all inquiries because our physical energy and 
resources for answering individual requests are finite. As PUG grows, we 
unfortunately succumb to the reality of (1) having to insist that people 
who need to know ,l about Pascal" join PUG and read Pascal News - that is 
why we spend time to produce it! and (2) refusing to return phone calls 
or answer letters full of questions - we will pass the questions on to 
the readership of Pascal News . Please understand what the collective 
effect of individual inquiries has at the "concentrators" (our phones and 
mailboxes). We are trying honestly to say: "we cannot promise more than 
we can do." 

* An attempt is made to produce Pascal News 3 or 4 times during an academic year 

from July 1 to June 30; usually September, November, February, and May. 

* ALL THE NEWS THAT FITS, WE PRINT. Please send material (brevity is a virtue) for 

Pascal News single-spaced and camera-ready (use dark ribbon and 18.5 cm lines!). 

* Remember: ALL LETTERS TO US WILL BE PRINTED UNLESS THEY CONTAIN A REQUEST TO 

THE CONTRARY. 

* Pascal News is divided into flexible sections: 

POLICY - tries to explain the way we do things (ALL-PURPOSE COUPON, etc.). 

EDITOR'S CONTRIBUTION - passes along the opinion and point of view of the 
editor together with changes in the mechanics of PUG operation, etc. 

HERE AND THERE WITH PASCAL - presents news from people, conference 
announcements and reports, new books and articles (including reviews), 
notices of Pascal in the news, history, membership rosters, etc. 

APPLICATIONS - presents and documents source programs written in Pascal for 
various algorithms, and software tools for a Pascal environment; news of 
significant applications programs. Also critiques regarding program/algorithm 
certification, performance, standards conformance, style, output convenience, 
and general design. 

ARTICLES - contains formal, submitted contributions (such as Pascal 
philosophy, use of Pascal as a teaching tool, use of Pascal at different 
computer installations, how to promote Pascal, etc.) 

OPEN FORUM FOR MEMBERS - contains short, informal correspondence among 
members which is of interest to the readership of Pascal News . 

IMPLEMENTATION NOTES - reports news of Pascal implementations: contacts 
for maintainers, implementors, distributors, and documentors of various 
implementations as well as where to send bug reports. Qualitative and 
quantitative descriptions and comparisons of various implementations are 
publicized. Sections contain information about Portable Pascals, Pascal 
Variants, Feature-Implementation Notes, and Machine-Dependent Implementations. 

* Volunteer editors are (addresses in the respective sections of Pascal News ): 

Andy Mickel - Outgoing editor; Rick Shaw - Incoming editor 

John Eisenberg - Here and There editor 

Rich Stevens - Books and Articles editor 

Bob Dietrich and Gregg Marshall - Implementation Notes editors 

Jim Miner and Tony Addyman - Standards editors 

Andy Mickel and Rich Cichelli - Applications editors 

Jenny Sinclair and Rick Marcus - Tasks editors 
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ALL-PURPOSE COUPON 



Pascal User f s Group, c/o Rick Shaw 
Digital Equipment Corporation 
5775 Peachtree Dunwoody Road 
Atlanta, Georgia 30342 USA 



** 



(Ol-Dec-79) 



••Note 

Membership is for an academic year (ending June 30th). 

Membership fee and All Purpose Coupon is sent to your Regional 

Representative. 

See the Policy section on the reverse side for prices and 

ALTERNATE ADDRESS if you are located in the European or 

Australasian Regions. 

Membership and Renewal are the same price. 

The U. S. Postal Service does not forward Pascal News. 



] Enter me as a new member for: 
] Renew my subscription for: 

] Send Back Issue(s) 



[ ] 
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ending 
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1981 


[ ] 


3 


years 


ending 


June 


30, 


1982 





] My new/correct address/phone is listed below 

] Enclosed please find a contribution, idea, article or opinion 
which is submitted for publication in the Pascal News. 

] Comments: 
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ADDRESS 
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COMPUTER. 
DATE 
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JOINING PASCAL USER'S GROUP? 

Membership is open to anyone: Particularly the Pascal user, teacher, 

maintainer, implementor, distributor, or just plain fan. 

Please enclose the proper prepayment (check payable to "Pascal User's 

Group"); we will not bill you. 

Please do not send us purchase orders; we cannot endure the paper work! 

When you join PUG any time within an academic year: July 1 to June 30, you 

will receive all issues of Pascal News for that year. 

We produce Pascal News as a means toward the end of promoting Pascal and 

communicating news of events surrounding Pascal to persons interested in 

Pascal. We are simply interested in the news ourselves and prefer to share 

it through Pascal News . We desire to minimize paperwork, because we have 

other work to do. 

American Region (North and South America): Send $6.00 per year to the 
address on the reverse side. International telephone: 1-404-252-2600. 
European Region (Europe, North Africa, Western and Central Asia): Join 
through PUG (UK). Send £4.00 per year to: Pascal Users 1 Group, c/o 
Computer Studies Group, Mathematics Department, The University, Southampton 
S09 5NH, United Kingdom . International telephone: 44-703-559122 x700. 
Australasian Region (Australia, East Asia - incl. Japan): Join through 
PUG(AUS). Send $A8.00 per year to: Pascal Users 1 Group, c/o Arthur Sale, 
Department of Information Science, University of Tasmania, Box 252C GP0, 
Hobart, Tasmania 7001, Australia . International telephone: 61-02-23 0561. 

PUG(USA) produces Pascal News and keeps all mailing addresses on a common 
list. Regional representatives collect memberships from their regions as a 
service, and they reprint and distribute Pascal News using a proof copy and 
mailing labels sent from PUG(USA). Persons in the Australasian and European 
Regions must join through their regional representatives. People in other 
places can join through PUG(USA). 

RENEWING? 

Please renew early (before August) and please write us a line or two to tell 
us what you are doing with Pascal, and tell us what you think of PUG and 
Pascal News . Renewing for more than one year saves us time. 

ORDERING BACK ISSUES OR EXTRA ISSUES? 

• Our unusual policy of automatically sending all issues of Pascal News to 
anyone who joins within a academic year (July 1 to June 30) means that we 
eliminate many requests for backissues ahead of time, and we don't have to 
reprint important information in every issue — especially about Pascal 
implementations ! 

- Issues 1 .. 8 (January, 1974 - May 1977) are put o f print . 
(A few copies of issue 8 remain at PUG(UK) available for £2 each.) 

- Issues 9 .. 12 (September, 1977 - June, 1978) are available from PUG(USA) 
all for $10.00 and from PUG(AUS) all for $A10. 

- Issues 13 .. 16 are available from PUG(UK) all for £6; from PUG(AUS) all for 
$A10; and from PUG(USA) all for $10.00. 

- Extra single copies of new issues (current academic year) are: $3.00 each 
- PUG(USA); £2 each - PUG(UK); and $A3 each - PUG(AUS). 

SENDING MATERIAL FOR PUBLICATION? 

- Your experiences with Pascal (teaching and otherwise), ideas, letters, 
opinions, notices, news, articles, conference announcements, reports/ 
implementation information, applications, etc. are welcome. "All The News 
That's Fit, We Print." Please send material single-spaced and in 
camera-ready (use a dark ribbon and lines 18.5 cm wide) form. 

- Remember: All letters to us will be printed unless they contain a request 
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UNIVERSITY OF MINNESOTA 

TWIN CITIES 



University Computer Center 

227 Experimental Engineering Building 

Minneapolis, Minnesota 55455 



Special Issue 

This special issue on the Pascal Validation Suite was prepared primarily by 
Jenny Mizielinski (now Jenny Sinclair) and Arthur Sale of the Department of Information 
Science at the University of Tasmania. We owe special thanks to Jenny because she does 
most of the work for PUG Australasia, and she should have been listed as a "tasks editor" 
long before now--in fact as far back as 1977! 

The Validation Suite represents a valuable weapon in Pascal's arsenal because it provides 
a common measuring instrument for standards conformance. As has been said before, Pascal 
now joins a small and elite group of programming languages which has such a collection of 
test programs. 

Note that the Validation Suite is copyright, but that it can be obtained wery easily and 
inexpensively from three (3!) worldwide distributors' ANY user of ANY Pascal compiler 
ANYWHERE should not pass up this opportunity! 

Rick Shaw 

Next issue (PN#17) will be Rick Shaw's first issue as editor and is now 
scheduled for December. (This issue is my last one as editor.) Please don't be alarmed 
that Rick works for DEC. He will keep PUG and DEC strictly separated. (Besides he is 
just as funny and crazy a person as I am!) As I said in my editorial in PN #15, Rick is 
a capable administrator (whereas I am not good at delegating responsibility), and he has 
the luck of being in a nice work environment at DEC's Atlanta Regional Office with ready 
access to clerical facilities, etc. We were able to recruit section editors (listed on 
the inside front cover)to whom Rick can now distribute the work of Pascal News . 
Decentralization is manditory if Rick is to survive my fate. Good luck, Rick! 

About a year and a half ago it would have been hard for me to say goodbye to Pascal News . 
Now it is really easy! I'm really weary and "burned-out" having worked hard all year-- 
even after having said in issue #13 that I was tired of doing the job. Also I'm comforted 
that as of about a year ago, it became undeniably obvious that together all of us Pascalers 
permanently established Pascal as a major programming language— not just "another" 
language. All progress since then has been and will be pleasant dividends. 

Rick's volunteering to be editor for 2 years comes just in the nick of time:, a reluctant 
editor such as myself doesn't contribute to the quality of Pascal Mews . Rick will provide 
fresh ideas whereas I'm running out of ideas. 

I feel relieved to be rid of the day-to-day responsibility for Pascal News and PUG. 
(However I intend to help Rick every way I can.) I do admit that working on all phases of 
PUG and Pascal News has made me a better person. I had the privilege to experience the 
processes of organizing, accounting, budgeting, editing, filing, printing, archiving, 
implementing ideas, pasting-up, publishing, planning, mailing, banking, maintaining mailing 
lists, juggling details, coordinating events, reading faster and writing better, and 
talking and working and negotiating and learning with other people! 

Thanks 

It's the honest truth: we've received hundreds of encouraging and favorable 
comments about Pascal Nev/s . It was truly gratifying to receive nice words this year when 
our hopes were dim and spirits were down. But then it is only appropriate to thank 
everyone who contributed material and ideas to Pascal News (by sending them in) and made 
the whole effort possible. Regular contributors were especially valuable. (As an example 
there is no reader of Pascal News who doesn't know Arthur Sale. He is a Pascal "folk-hero" 



because his prolific efforts are accompanied with an unforgettable signature and the end- 
of-the-earth Tasmanian letterhead.) I've been much less an editor than a collector and 
organizer of information, and I would like to say "Thanks!" and encourage all of you to 
keep sending in information no matter how small. Unfortunately, I'm sure we still only 
know less than half of the news concerning the use of Pascal! 

We (especially myself) are indebted to the people whose names are listed below. They 
volunteered their time, energy, and enthusiasm over the last 4 years directly producing 
and distributing Pascal News (listed chronologically): 
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John Strait 1976 






Herb Rubenstein 1977 






Christi Mickel 1976, 


1977, 1978 




Arthur Sale 1977, 


1978, 


1979 (Aus 


Tim Bonham 1976, 


1977, 1978 




Jenny Sinclair 1977, 


1978, 


1979 (Aus 


Judy Mull ins Bishop 1976, 


1977 (U.K.) 




Rich Cichelli 1978, 


1979 




Tony Gerber 1976, 


1977 (Aus.) 




Scott Bertilson 1978, 


1979 




Carroll Morgan 1976, 


1977 (Aus.) 




Steve Reisman 1978 






Sara Graff under 1977, 


1978 




Liz Karl 1978 






Jim Miner 1977, 


1978, 1979 




Jerry Stearns 1978, 


1979 




John Easton 1977, 


1978 




Kay Holleman 1978 






David Barron 1977, 


1978, 1979 


(U.K.) 


Rick Shaw 1978, 


1979 




Rick Stevens 1977, 


1978, 1979 




Tim Hoffmann 1978 






Tony Addyman 1977, 


1978, 1979 


(U.K.) 


Rick Marcus 1979 






How do we put together an issue of EascaOews? 









.)- 



Invariably the process begins by catching up (1) on the mail. This means 
opening an accumulation of what used to be 2-4 weeks worth in the early days of PUG to 2-22 
weeks worth recently (I'm talking about trays of mail 1 or 2 meters long!). The mail must 
be separated (2) into new subscriptions, renewals, inquiries for information, changes of 
address, incorrect payments (returned), purchase orders without prepayment (returned), 
miscellaneous queries, and material for publication in Pascal News . (To keep our files 
uniform and organized we manually fill out an All -Purpose Coupon for new subscriptions 
and renewals; for requests for old backissues, we manually write out an address label.) 

The money must be deposited (3) and accounted for (4). New members and renewers must be 
keyed into the data base (5) and then checked for errors (6). Back issues are mailed (7). 
The roster increment is run off (8), and the All-Purpose Coupons with tidbit comments are 
photocopied (9) for the Here and There editor. 

The material for Pascal News is gathered together in a pile (10) and then sorted (11) into 
regular categories (Here & There, Open Forum, etc.). The Implementation Notes section is 
preprocessed (12) (outlined) and given to the Implementation Notes editors. The Books and 
Articles section is treated in the same way. 

The Articles section is planned and received-dates added (13). The Open Forum section is 
planned (14). At this point all parts of the issue are attacked (15) at the same time 
including the subsections of Here & There not mentioned and the Applications section. The 
cloud which hangs over the process is writing the editorial (16) which delays actual page 
layout and pasteup of the rest of the issue. 

When the camera-ready copy of the editorial and everything else is ready (or nearly so), 
paste-up with rubber cement on large computer-listing paper begins (18). Each sheet of 
large paper was previously titled and page-numbered (17) in a typewriter. The completed 
original is photocopied (19) to produce the 2 copies for PUG(UK) and PUG(AUS) to print 
from. It is then sent (20) to the printer together with a print order. 

Unfortunately, these events don't always occur in this order, thus creating synchronization 
problems. Needless to say we are always alert for news about Pascal in other journals and 
from people who call on the phone. 
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Editor's Contribution 
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Editor's Contribution 
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In Closing 

As an escape clause, I've always listed: "as well as the ideas behind Pascal" 
together with "promoting the use of Pascal" as a purpose of Pascal User's Group. We all 
know that Pascal is not a perfect language, but that it best embodies the ideas of the 
structured-programming revolution of the 1970's. 

Acceptance in the United States has been the icing on the cake and was crucial to Pascal's 
success as a popular programming language (sorry, ALGOL-68!). So if you stop to think, 
it is important to note that the Pascal movement in the United States was spearheaded by 
George Richmond (with some initial help by Lyle Smith, a friend of Niklaus Wirth) at the 
University of Colorado Computer Center primarily during the years 1972 to 1975. 

The effort has been continued by Pascal User's Group via Pascal News by communicating 
"vast quantities of information" from late 1975 to present. Pascal News and Pascal User's 
Group (that is, all of us!) succeeded in centralizing authority for Pascal's acceptance, 
development, and standardization. 

What we have done through the medium of Pascal News which was not being done (and probably 
could not have been done) by any other journal was to openly advocate the superiority of 
the principles behind Pascal. Perhaps we succeeded in shaking up enough people to 
accelerate rationality in programming and sensibility in computing by a number of years. 

We oversaw a political process and interjected some self-fulfilling propheses to keep the 
action rolling. Inevitably we all were affected by the spectacular outcome ourselves! 
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PUG is not deadl 
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As a closing note, I would like to ask that all of you start 
using the new All Purpose Coupon published in this and 
subsequent issues of the News. It will speed the transition 
up tremendously between Andy and myself. 

See you all next issue. Long live PUG! 
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Rick Shaw 
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don't forget to RENEW your Pascal News subscription 



DIGITAL EQUIPMENT CORPORATION, 5775 PEACHTREE-DUNWOODY ROAD, SUITE 100D. ATLANTA, GEORGIA 30342 
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Introduction to Special Issue 



The Pascal Validation Suite . 
Aims and Methods 



by A.H.J. Sale, 

Department of Information Science, 
University of Tasmania. 



1979 July 13 



Once upon a whisper -time - so it is said but who would believe 
it? - long before the Minnipins reached the Land Between the 
Mountains s the Glooken of Then played upon his bells and the 
beetle-bores 3 which had come to infest the country side > fell 
upon their backs and waggled their legs for a space and died. 
But the smell of dead beetle-bores was great 3 and the bells 
could do nothing about that, and this I believe. 

Pretend-story , told by Glocken to Glocken 

to Glocken, from Then to Now. 

(by Carol Kendall - The Whisper of Glocken) 



1. Definition 

A Pascal validation suite? What is that? Ignoring the facetious 
definitions, such as a suite of motel rooms where a Pascal salesman 
wines and dines clients and promotes the features of the language, 
there are still a lot of possibilities. 

It might be a set of programs that check whether some other (input) 
text is a valid Pascal program or not. (This may run into the 
halting problem, well-known to be incomputable). But it isn't. The 
shortest definition I can supply which describes the validation suite 
I am talking about is: 

The validation suite provides programs and procedures 
whereby the correctness (or otherwise) of a Pascal 
processor may be tested. 

2. Syntax + Semantic s 

There are two key words in this definition which have been carefully 
chosen, and which deserve consideration. Firstly, the definition 
encompasses a Pascal processor , not a compiler. The definition there- 
fore covers processors that compile native machine-code and run it, 
processors that utilize an intermediate code and an interpreter (for 
example the P-compiler) , direct execution systems and pure interpreters. 

But more importantly, the term processor encormpasses both the analysis 
of the source text of a program on an execution system. I am not 
interested solely in determining that a compiler is "correct", what- 
ever that means, but in determining that the compilers-machine pair- 
is correct. To take a very simple example, the following program fails 
on some processors: 



b:=true; c:=false; 
if (b=(not c)) then writeln('PASS' ) 
else writeln( 'FAIL') ; 

What goes wrong? On analysis of the failures, the compiler seems to 
generate good, correct, code. Giving P-like code as an example* the 
test compiles to: 

LOAD b {to stack) 

LOAD c [to stack) 

NOT {logical inversion of c) 

EQUAL {test equality, leave logical result) 

BRFL . . . {branch if false) 

The flow usually resolves into a failure of the compiler assumptions. 
The NOT instruction perhaps does not do the transform true <+ false , 
but does a whole-word bit inversion. Coupled with the action of an 
equality test, of course it may then fail! The bit pattern resulting 
from inverting the false-pattern is not necessarily the same as the 
true-pattern. 

Resolution of this problem can take several paths, presuming that the 
machine architecture is fixed. (This assumption is false for inter- 
preters, of course). The simplest resolution is to ensure that every 
occurrence of the not -operator results in code that allows only the 
bit-patterns 00... TW and 00.... 01 to be generated, as is the usual 
representation of boolean values in more than one bit. In the 
Burroughs B6700 this can be achieved by emitting the instructions: 

LNOT {wordwise logical inversion) 
I SOL (0,1) {isolate the 0-th bit) 

Another resolution hinges on the manner in which the branch tests 
are done. Suppose that the machine, when faced with a complex logical 
expression, generates a sequence of branch instructions which lead 
eventually to loading a true or false value (or a branch if that is 
required. ) 

A third resolution permits other representations for true and false 
(perhaps including don't care bit positions), but realizes that an 
unusual representation may require special coding 

(a) at conditional branch points 

(b) wherever ordering is important (eg. for parameters of ord, succ 
and pred applied to boolean operands), and 

(c) in 'relational expressions' involving booleans, which may be 
turned into something other than number comparisons (eg. exclusive- 
or). 

For example, in the Burroughs B6700 the representations ??..?0 and ??..?1 
would suffice as the conditional branch instructions sense only the 
right-end bit, and consequently complex code would only be needed for 
the relatively unusual case where the ordering of the values was 
relevant. But this is not a treatise on implementing booleans. 
Suffice it to note that testing a processor involves the semantics as 
well as the syntax, and the machine as well as the compiler. 

3. Ultimate futility or useful weapon 

The other carefully chosen word in the definition is correctness . 
Many people have pointed out that testing cannot prove a program to be 
correct; it can only uncover bugs in it. Since a compiler is a program, 
and only part of a Pascal processor, is testing therefore an exercise 
in futility that we should abandon in favour of proving the compiler- 
machine pair to be a correct implementation of Pascal? 
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Of course, yes, if we were capable of it. But proof procedures are 
still human processes, and still subject to error and oversight. There- 
fore, even proved systems should be subject to testing in order to 
uncover weaknesses of the proof or oversights. It will be obvious that 
this is necessary when it is realized that Pascal -P, despite its 
heritage of careful design, its origin in Zurich, and its extensive 
testing, still has errors in it which can be detected in most of its 
descendants. 

The validation suite is a set of programs, methodically assembled (and 
otherwise) which therefore exercise a Pascal processor fairly thoroughly 
and hopefully uncover many of the flaws in its design or mistakes and 
deviations from the intended actions. 

So much for the theory. How does it work in practice? 

4. Conformity 

The most obvious set of tests to incorporate are those set down in the 
Pascal Standard as required of a Pascal processor, or implied to be. 
These were generated by systematically working through the Standard and 
wherever it said something was allowed, writing a program to check that 
it was. All such programs are, of course, standard Pascal. 

Since the program should execute, it is arranged to print 'PASS' if it 
works correctly. Some such tests check semantic details, and incorporate 
run-time checks that lead to failure messages. By the nature of the 
test, several conformity checks can be included in one test program. 
Any failure is sufficient to show up a flaw: successful programs exer- 
cise, all tested features. 

However there are three problems: iteration, depth and irregularity. 

The first arises with iterative/recursive syntax, or axiomatic recursive 
semantics. Clearly no program can test all cases of a potentially 
infinite system! This is tackled by the "one, two, many" principle, 
named after the primitive enumeration systems of nomad Bushmen in 
southern Africa. The test will include a minimum case of the construct, 
probably its successor, and a case which is a small multiple of iterations/ 
recursions, and quite plausible. For example, for identifiers in a var 
declaration: 

program txxx (output) ; 
var 

onlyone : integer; 

first, second: boo lean; 

x0,xl,x2,x3,x4 : char; 
begin 

Since no processor in a finite computer can provide for infinite recur- 
sion/iteration, these tests establish a ptuma &CUCA.2, case that the cons- 
truct is present and works for small instances up to some unknown limit. 
To establish that the limit is sufficiently high that it will almost 
never prove to be a problem - what I have called a virtual infinity - 
another program is written which has a repetition slightly (and only 
slightly) beyond a plausible maximum. Perhaps 100 cases might be 
enough for some things, and 20 for other things. Such tests are 
regarded as not being compulsory, and form part of the quality measure- 
ment category. (Nevertheless, a processor may fail even a quality 
test by getting itself knotted, or giving an erroneous diagnostic, or 
behaving in an unexpected fashion ) 



The third problem is irregularity. Successful execution of a test is 
no guarantee that the same feature will be handled correctly in a 
different context. Unfortunately there is no way to know all possible 
context changes that might affect the outcome, and the designers of 
the test programs have had to draw on their knowledge of machines and 
implementation techniques to explore this difficult area. A good 
example is the implementation of type boolean. Clearly, from our 
earlier discussion, relational operators must be tested separately for 
booleans and other scalar types. 

Another example which maybe should be in the test package, but isn't 
yet, is the following 

- csquared : =2. 0*alpha*bet a; 
if csquared = a*a+b*b then 

{writeln(a,b, sqrt (csquared))} ; 

A particular processor noted that csquared was used immediately after 
its assignment and modified the code to leave this value on the run- 
time stack to eliminate the fetch. A separate optimizing routine 
realized that the if -statement had no effect once the debug print was 
factored out, and deleted the whole of the if -statement code. Result: 

the stack grew every time this code was executed Such interactions 

require cunning and experience to deduce, let alone devise tests for 
their presence. 



5 . Deviance 



Besides saying what ought to be allowed, the Pascal Standard says what 
ought not to be allowed, both explicitly and implicitly. If a processor 
allows such constructs, it is either a deviant processor and ought to 
be fixed, or it embodies some deliberate extension which ought to be 
documented. 

Note that it is pointless trying to detect all possible extensions: 
they form an infinite set! In any case this is not the purpose of 
deviance tests. Their purpose is to detect the many traps and failures 
to enforce reasonable restrictions which compiler implementors can un- 
wittingly place in the way of users. 

Some deviance tests are directly suggested by the Pascal Standard. Good 
examples are afforded by the restrictions placed on for-statement control- 
variables. But by far the larger group are not. These rely on the 
test program writers' intelligence and knowledge of compilers and on the 
ability or experience to recognise possible problem areas. Two examples 
will illustrate this. 

The first was derived from some experience with an optimizing compiler 
which generated different code for 

j div k 

depending on whether k was a constant power of two or not, or so the 
documentation said. This immediately challenged the hardware designer 
in me to check this out, and challenged my software designing side to 
prove it correct. Since the optimization relied on a property of the 
integer representation, it was potentially possible for it to fail. 
Sure enough, on this compiler, it did: j div k returned different 
results for the same value of k y solely depending on whether it was a 
constant or not. 
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The second case grew out of a knowledge of the workings of the compat- 
ibility algorithm of most Pascal compilers, and some strict wording in 
the Standard. Strictly 



type 



is not a 'string' type 
constant . Thus 



digit str in g=packed array [1.. 10] of '0'..'9'; 

and not compatible with the usual quoted string 



var 

d : digitstring; 
begin 

d:='0123456789'; 

is not correct Pascal: it is a deviation or an extension. Of course, 
compilers that allow it as an extension ought to do it properly (ie. 
consistently with the axioms of Pascal), so this naturally gives rise 
to the attempt: 

d:='ABCDEFGHIJ'; 

which is plain impossible. 

Enough of examples. It will be obvious that every deviance test 
program is non-standard, and that they should mostly fail to execute 
to completion. Unlike conformance tests this means that each deviance 
test tries one and only one deviation. Otherwise one failure might 
mask another, more serious. Conformance and deviance tests make up 
the majority of the tests (71% of the current suite), and do the bulk 
of the exercising of the compiler. 

Errors and implementation features 

The Pascal Standard also specifies a number of situations which are 
specified to be errors, implementation-dependent, or implement at ion - 
defined. Each of these gives rise to a test or tests that evoke the 
feature so specified. 

In the case of errors and implement at ion -dependency, the purpose is to 
enable documentation of the error -handling capability of the processor. 
Hopefully all errors are detected; in practice some of them survive 
into production software and may even become part of programmer's 
assumption kit... All such programs are directly suggested by the 
Standard, evoke one and only one error, and are standard Pascal except 
for the error. 

Naturally, implement at ion -de fined features should be documented, and the 
corresponding tests attempt to do this by a variety of techniques. Some, 
like printing the value of max in t, are simple standard Pascal. Others, 
like trying to detect the significance limit of identifiers, rely on 
assumptions about the nature of the lexical analysis and scope and are 
clearly not standard. The inclusion of these tests is really to improve 
the documentation of Pascal processors. 

The number of tests in those categories is small and unlikely to change 
much. The specific things they test are more or less fixed by the 
Standard. 

Quality 

All the preceding tests address the problem of whether the processor 
conforms to the Pascal Standard and, where necessary, how. It is also 
relevant to ask whether the implementation measures up to some quality 
standards, and the validation suite therefore contains tests which 
attempt to assess quality, however you define it. 



As you might expect, these tests form a motley group. Some attempt to 
assess whether the processor provides some hard limits that are likely 
to annoy in a particular direction, or whether the limits are at virtual 
infinity. Others attempt to assess accuracy of mathematical functions 
such as sqrt(c). What they all have in common is a requirement for 
greater analysis of the results and a value judgement. 

Of course, a processor may fail even a quality test by totally mishand- 
ling it. For example, if the compiler goes into an infinite loop, or 
gets its lexical levels screwed up. But this is not the intention, 
and is rare. 

This group of tests is likely to have the greatest growth rate in 
future revisions of the validation suite. For obvious reasons, the 
first release version has concentrated on correctness, and while there 
may be some growth in tests for conformity and deviance as we under- 
stand the problem better, it is already apparent that the suite lacks 
quality tests in several areas: 

(a) tests that can be timed, 

(b) tests whose space utilization is measurable, 

(c) tests of compiler diagnostic ability, 

and there are no doubt more. 



The breakdown of programs in version 2.1 by class is shown below. 
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8. Feedback 



No validation suite can ever be perfect. Since its task is infinite, 
one can only approach perfection with varying degrees of success. 
Consequently, it is very important that a continuous revision of the 
suite is maintained, with three main objectives in mind: 

(a) Removal or modification of tests that do not agree with 
requirements of the Pascal Standard. 

(b) Addition of new tests arising from experience and context 
changes, and therefore unexpected interpretations. 

(c) Expansion of quality control tests aimed at improving the 
quality of Pascal processors in all dimensions of choice. 

Suggestions for categories (b) and (c) are therefore welcome. Complaints 
about category (a) are even more important. All will be read, digested, 
and carefully considered, though clearly some purely idiosyncratic tests 
may not make it into the package. 

There is no formal bug-reporting service. Simply write to me at the 
following addresses: 



up to January 1980 



from January 1980 



Professor A.H.J. Sale, 

c/- Professor D.W. Barron, 

Department of Computer Studies, 

The University, 

Southampton, England S09 5NH 

UNITED KINGDOM. 

Professor A.H.J. Sale, 

Department of Information Science, 

University of Tasmania, 

GPO Box 252C, 

Hobart, Tasmania 7001 

AUSTRALIA. 

Please enclose a listing and any other information relative to the 
report /request . 

But this is not enough! Simply casting the validation suite out into 
the wide world calls out for more. My own curiosity is reason enough, 
but in addition it has become apparent that overseeing the results of 
other people's passes of the validation suite against a processor can 
be extremely valuable. 

Accordingly I ask you to write to me if you are prepared to send 
documentation on a validation run for a processor I haven't already 
collected. I will let you know if we already have data on that, system. 
The documentation I would want is: 

(a) a complete set of listings of runs of the validation programs, 
annotated to explain any obscure effects. 

(b) a validation report, similar to the one produced for our own 
compiler. 

(c) an accurate identification of the processor (compiler source and 
date of acquisition or version, machine identification). A manual 
would be useful too. 

With help we can begin to assemble a comparative list of processor 
performance, and watch the way the situation evolves. 



9. Utilization 

I hope to see copies of validation reports for processors of significant 
interest in future editions of Pascal News. Obviously implementors will 
want to fix minor bugs, but may baulk at fixing difficult ones or 
publishing the results. Some comparative results published by respons- 
ible users will assist readers of the News to assess comparative merits 
of compilers, may bring some collective user pressure to bear on the 
implementors/maintainers to fix even the more persistent and difficult 
bugs, and will assist the Users Group to assess which systems are still 
active or most in use. I hope to see the validation suite being used 
by at least two groups of people: the implementors/maintainers and the 
users. 

Implementors of course will use the package to check out their product; 
maintainers would be well-advised to do the same after each major 
revision. They will also be able to compare their efforts against 
other compilers more easily, and a bit more competition will be good for 
both suppliers and users. 

Users will be able to use the package to bring pressure on suppliers to 
conform to the draft standard, and therefore use the package to evaluate 
the relative merit of two or more systems. Also, because the validation 
suite is virtually the Pascal Standard cast into test programs (with 
some reservations), access to the essential concepts of the Pascal 
Standard will be made more clear by inspection of the conformance and 
deviance tests. 

Naturally, as the draft Pascal Standard stabilizes, the agreed resolutions 
will be embodied in further tests, thereby both providing an enforcement 
technique, and a method of publicizing the agreement. For example, this 
may happen in the area of the pack and unpack procedures which are perhaps 
overly restrict ively defined. 

10. A Confession 

Once upon a time, long ago, programmers who could write tricky code were 
prized. This pleased them, because they were being well -rewarded for 
doing what they enjoyed: creating private masterpieces of complexity 
on a small scale. Any modern abstract artist would understand the 
feeling. 

Now, programming has completely changed. We strive to write correct 
programs together with their proofs. The creativity, and the accompany- 
ing surge of pleasurable sensations on completion of a particularly 
difficult task, are still with us, but in a different form, and with 
different nuances and vibrations. I enjoy this tremendously when admin- 
istrative chores allow me to indulge myself in writing programs, and I 
wouldn't give up the advances we've made in programming methodology for 
anything. 

And yet, there is still that fascination with those tricky, nasty jewels 
we created. I must therefore confess that I believe that when the last 
tricky programmer on earth expires his or her last breath over a soggy sheet 
of paper, he or she will probably be writing a validation program. It 
seems to be the last refuge left for contorted thought, for to paraphrase 
a famous fictional detective (I think it was Hercule Poirot) , how can 
you discover what crime has been done unless you can put yourself into 
the frame of mind of the criminal? 
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11. Some favourite tests 

1 must confess to having some favourite tests, which either are 
utterly useless and indulge a peculiar sense of humour, or are partic- 
ularly devastating. I share them with you in case you might, too, 
share this sense of humour. 

(a) Syntactic 

Test 6.4.2.3-1 

The interesting thing here is the peculiar scalar 

type 

singularitytype = (me); 
which doesn't seem to be useful for anything, though you can assign to 
it, test it, etc. The apparently similar (test 6.4.1-1): 

type 

purelink = I purelink; 
is less amusing because it does have at least two distinct potential 
uses. 

(b) Context-sensitive 

Test 6.4.3.3-4 

Here the use of a field-name which is already defined trips up a number 
of compilers. They don't wait to find the colon before rushing into 
analysis. Most Pascal -P compilers inherit this one. 

(c) Scope 

Test 6.2.2-2 

The sheer perversity of being able to write 

if true = false then writeln ('PASS') 
is delightful. 

(d) Execution 

Test 6.8.3.9-7 

The beauty of this one lies in two aspects: many processors completely 
fail it, and our compiler turned out to pass it quite unexpectedly. It 
comes as a surprise to devise a test that you confidently expect to fail 
on your own implementation, and then the thing makes a fool of you by 
working.... And then you have to work out how it outsmarted you. To 
add to its perverse charm, it usually turns out to have a simple resolu- 
tion which, though unattractive, requires only that maxint be reduced 
by one. 

(e) Errorhandling 

Test 6.6.5.2-6 

I must admit that the attraction of this one lies both in the weird 
variety of effects it can evoke, and to some extent by the clarity with 
which the aliasing problem points an accusing finger at the file buffer 
concept. Intere >•' : ingiy, a simple restriction would remove the problem, 
by simply not permitting file-buffers in such contexts, but it would 
introduce more irregularity.... 
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THE PASCAL VALIDATION SUITE 
Version 2.2 



DISTRIBUTION INFORMATION AS AT 20 AUGUST 1979 



Revision History 

Version 2.0 was the first release of a completely rewritten package which 
was based on earlier work by B.A. Wichmann and A.H.J. Sale. This earlier 
work is considered to be version 1, and is now obsolete. 

Version 2.0 was indexed to Working Draft 3 of the Pascal Standard as published 
in Pascal News #14. Version 2.1 fixed up a few bugs detected after release. 
Version 2.2 is altered in indexing to refer to the draft ISO Standard 
document IS0/TC97/SC5/N462, and incorporates more tests which facilitate 
the timing and measurement of quality in Pascal processors. Subsequent 
revisions will be issued when either detected errors in the package require 
a revision, or when a new version of the draft standard is released. 

Purpose 

The validation suite is provided to exercise Pascal processors and to 
determine by testing whether the processor conforms to the requirements of 
the Pascal Standard or not, and to provide a common set of programs for 
documenting implementation -dependencies and quality of implementation. It 
is strongly oriented around the draft Pascal Standard, and tests are 
suggested by that document. A few proposed tests have been omitted because 
it has been suggested that the draft Standard will be revised in that area, 
but these are few. It follows therefore that any revisions of the draft 
Standard will cause revisions of the validation suite. The suite currently 
contains over 300 programs. 

Acquisition 

To acquire a machine -readable copy of the validation suite, apply to one of 
the distribution centres. It will be necessary to fill in a software licence, 
and a small fee (around US$50) is charged to cover costs. The fee covers 
the supply of a magnetic tape, the copying of the validation suite onto the 
tape, airmail postage to the address provided, and a limited notification 
service relating to later releases or inaccuracies detected in the suite. 



Restrictions 

The conditions of release prohibit the distribution of the package to third 
parties so as to limit the growth of unauthorized and inaccurate versions. 
The likely incidence of change if the draft standard is revised will show 
the desirability of this requirement. However, no restriction is placed on 
the use of the package for validating Pascal processors, for benchmarking, 
for acceptance tests, for preparing comparative reports, and similar 
activities, nor on the distribution of the results of such use. 



The validation suite is expected to be widely used and distributed, 
restricted to a small subset of the user community. 



C/> 
O 



Feedback 



No special reporting mechanisms have been set up. However, the authors 
will attempt to produce revisions of the validation suite and distribute 
them to the distribution centres as necessary, and to publicize their 
availability. 

Information relating to a pass of the validation programs against a 
particular processor would be welcome at the University of Tasmania, but 
it must be understood that the authors cannot provide full reports on all 
listings provided. 

Of particular value would be any tests that produced entirely unexpected 
results which may be of wider interest, or which are without any reasonable 
explanation from the user's point of view. In some cases the authors may 
be able to deduce the likely cause, or recognize an epidemic of common 
flaws. Any correspondance which points out an error in the classification 
of the programs in the suite, or in its construction, or suggests a new 
test, would be most welcome. 
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Address for suggestions or complaints: 

September '79 - January *80: 

Professor A.H.J. Sale, 

c/- Department of Computer Studies, 

The University, 

Southampton, England S09 5NH 

UNITED KINGDOM. 






February * 80 onwards: 

Professor A.H.J. Sale, 

Department of Information Science, 

University of Tasmania, 

GPO Box 252C, 

Hobart, Tasmania 7001 

AUSTRALIA. 
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A Pascal Processor Validation Suite 



by B.A. Wichmann 

National Physical Laboratory 
Teddington, Middlesex, 
TW11 OLW, United Kingdom 
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Abstract 

The document describes a series of test programs written in Pascal. The 
suite of programs may be used to validate a Pascal processor by presenting 
it with a series of programs which it should, or should not, accept. The 
suite also contains a number of programs that explore implementation-defined 
features and the quality of the processor. The tests are generally based 
on the draft ISO Standard for Pascal. 



NOTE 



This is a working document. It is being continually revised and extended. 
Comments, corrections, extra tests, and results of running any tests would 
be most welcome. 



Dated : 20 August, 1979 
Version: 2.2 



1. INTRODUCTION AND PURPOSE 
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This paper describes a suite of test programs which has been designed to 
support the draft Standard (Addyman, 1979) for the programming language 
Pascal (Jensen § Wirth, 1975) prepared for approval by ISO. (In the rest 
of this paper, the draft Standard is simply referred to as the Standard). 
It therefore follows similar work done by AFSC (1970) for COBOL, and 
Wichmann (1973,76,77) for Algol 60. 
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The suite of programs is called a validation suite for Pascal processors; 
however it is important to emphasize that no amount of testing can assure 
that a processor that passes all tests is error-free. Inherent in each test 
are some assumptions about possible processors and their designs; a proces- 
sor which violates an assumption may apparently pass the test without doing 
so in reality. Also, some violations may simply not be tested because they 
never occurred to the validation suite designers, nor were generated from 
the draft Standard. 

Two examples may illustrate this as a warning to users against expecting 
too much. Firstly, consider a fully interpretable Pascal processor. It may 
pass a test which contains a declaration which it would mis-handle otherwise, 
simply because the program did not include an access to the object concerned 
so that it was never interpreted. A second example might be a Pascal proces- 
sor which employs a transformation of the Pascal syntax rules. Since the 
pathological cases incorporated into the test programs are based on the 
original rules, a mistake in transformation may not be detected by the test 
programs . 
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On the other hand, the test series contains a large number of test cases 
which exercise a Pascal processor fairly thoroughly. Hence passing the tests 
is a strong indication that the processor is well -designed and unlikely to 
give trouble in use. The validation suite may therefore be of interest to 
two main groups: implementors of Pascal, and users of Pascal. 



Implementors of Pascal may use the test series to assist them in producing 
an error-free processor. The large number of tests, and their independent 
origin, will assist in detecting many probable implementation errors. The 
series may also be of use for re-validation of a processor after modification 
to incorporate a new feature, or to fix an error. 
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Users of Pascal, which includes actual programming users, users of Pascal- 
written software, prospective purchasers of Pascal processors, and many 
others, will also be interested in the validation suite. For them it will 
provide an opportunity to measure the quality of an implementation, and to 
bring pressure on implementors to provide a correct implementation of 
Standard Pascal. In turn, this will improve the portability of Pascal 
programs. To emphasize this role, the validation suite also contains some 
programs which explore features which are permitted to be implementation 
defined, and some tests which seek to make quality judgements on the proces- 
sor. The validation suite is therefore an important weapon for users to use 
in influencing suppliers. 



Naturally, implementors of Pascal are best placed to understand why a proces- 
sor fails a particular test, aid how to remedy the fault. However, the users 1 
view of a Pascal processor is mainly at the Pascal language level, and the 
fact of a failure is sufficient for the users' purpose. 



THE TEST PROGRAM STRUCTURE 
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Each test program follows a consistent structure to aid users of the suite 
in handling them. Most of the following rules apply to all programs: a 
few hold everywhere except in a few test cases meant to test the particular 
feature involved. Such rules are marked by an asterisk, and a following 
note points out the exceptions. 
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(i) Each program starts with a header comment , whose structure is 
given later. 

(ii) The header comment is always immediately followed by an explan- 
atory comment in plain English, which describes the test to be 
carried out and its probable results. 

(iii) Each program closes with the characters "end." in the first four 
character positions of a line. This pattern does not otherwise 
occur in the program text. 

(iv) All program lines are limited to 72 character positions. 

(v)* The lexical tokens used are in conformance with the conventions 
set out in the draft ISO standard, and reproduced in an appendix. 
Thus comments are enclosed in curly brackets, the not-equal token 
is "<>", etc. In addition, all program text is in lower case 
letters, with mixed-case used in comments in accordance with 
normal English usage. String- and character-constants are 
always given in upper-case letters. (Note: A few tests set out 
to check lexical handling, and may violate these rules. Trans- 
lation of mixed cases to one case will therefore make these tests 
irrelevant, but will have no other effect.) 

(vi) Direct textual replacement of any lexical token, or the comment 
markers, with the approved equivalents given in the Standard, 
will not cause the significant text on a program line to exceed 
72 characters. 

(vii) *The program writes to the default file output, which is therefore 
declared in the program heading. (Note: one test - the minimal 
program - does no printing; a few cross-references are virtually 
the same) . 
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2.1 The header comment 

The header comment always begins with the characters "{TEST" in positions 
1-5 of a line. No other comments are permitted to have the character "{" 
and "T" directly juxtaposed in this way. The syntax of a header comment 
in EBNF is given by: 

header-comment « "{TEST' program-number "," "CLASS*" category-name "}" . 

program-number = number {"." number} "-" number 

number = digit { digit} 

category-name = "CONFORMANCE" | "DEVIANCE" | "IMPLEMENTATIONDEFINED" | 
"ERRORHANDLINCT |"QUALITY" ("EXTENSION" . 

For example, a possible header comment is: 
{TEST 6.5.3-10, CLASS=CONFORMANCE} 

The program number identifies a section in the Standard which gives rise to 
the test, and a serial number following the dash to uniquely identify each 
test within that section. If other sections of the Standard are relevant, 
the explanatory comment will mention them. Hie program title is constructed 
from the section number by replacing "TEST" by "t", "." by "p" for point, 
and "-" by "d" for dash. TTius the above header comment belongs to a program 
t6p5pSdlO . This technique may also be used to name a program source text 
file name in processing. 



The category-name identifies a class into which this test falls. The 
function and design of each test depends on its class. These are explained 
later. Thus it is possible to read through the validation suite file and 
simply identify the header comment by the leading "{T" in the first two 
character positions, identify its section relevance and construct a unique 
identifier for each program, and to select programs of particular classes. 



2.2 The program classes 
2.2.1 CLASS=CONFORMANCE 

The simplest category to explain is CLASS=CONFORMANCE . These programs are 
always correct standard Pascal, and should compile and execute. With one 
exception (the minimal program), the program should print "PASS" and the 
test number if the program behaves as expected. In some cases an erroneous 
interpretation causes the program to print "FAIL"; in other cases it may 
fail before doing this (in execution, loading, or at compilation) . Conform- 
ance tests are derived directly from the requirements of the Standard, and 
attempt to ensure that processors do indeed provide the features that the 
Standard says are part of Pascal, and that they behave as defined. Since 
conforming programs execute to completion, typical conformance tests will 
include a number of related features; all will be exercised by processors 
that pass. 
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2.2.2 CLASS=DEVIANCE 

The next simplest category is CLASS=DEVIANCE . These programs are never 
standard Pascal, but differ from it in some subtle way. They serve to 
detect processors that meet one or more of the following criteria: 

(a) the processor handles an extension of Pascal, 

(b) the processor fails to check or limit some Pascal feature 
appropriately, or 

(c) the processor incorporates some common error. 

Ideally, a processor should report clearly on all deviance tests that they 
are extensions, or programming errors. This report should be at compile- 
time if possible, or in some cases in execution. A processor does not 
conform to the Standard if it executes to completion. In such cases the 
program will print a message beginning "DEVIATES", and users of the tests 
must distinguish between genuine extensions and errors. (In a few cases a 
possible extension is tested also for consistency under this class.) 
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It is obviously not possible to test all possible errors or extensions. 
The deviance tests are therefore generated from some assumptions about 
implementation (which may differ from test to test), and from experience 
with past flaws detected. No attempt is made to detect extensions based on 
new statement types or procedures, but attention is concentrated on more 
stable areas. Obviously since each deviance test is oriented to one 
feature, they tend to be shorter than conformance tests, and to generate 
a short series where one conformance test collects several examples. 
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2.2.3 CLASS=IMPLEMENTATIONDEFINED 

In some sections of the Standard, implementors are permitted to exercise 
some freedom in implementing a feature. An example is the significance 
limit of identifiers; another is the evaluation order of boolean expressions. 
The CLASS=IMPLEMENTATIONDEFINED tests are designed to report on the handling 
of such features. A processor may fail these tests by not handling them 
correctly, but generally should execute and print some message detailing 
the implementation dependency. The collection of such implementation 
dependencies is useful to the writers of portable software. Some tests in 
this category require care in interpretation, as the messages generated by 
the test program rely on some assumptions about the processor implementation. 
The programs may or may not be standard Pascal: often they are not. 

For example, one program attempts to measure the significance limits of 
identifiers by declaring a series of differing length in an inner procedure 
that are different from an outer series by their last letter. Thus it 
violates the requirement for uniqueness over the first eight characters and 
relies on masquerading redefinition under the scope rules for its effect. 
One processor, however, reports that just this is happening during compil- 
ation. Though this is ideal behaviour, it would destroy the test if the 
program then was not permitted to run. (In this case, in fact, the messages 
were only warnings.) 

2.2.4 CLASS=ERRORHANDLING 

The Standard specifies a number of situations by stating that "an error 
occurs if" the situation occurs. The tests of this class evoke one (and only 
one) such error. They are therefore not in Standard Pascal with respect to 
this feature, but otherwise conform. 

A correct processor will detect each error, most probably as it occurs during 
execution but possibly at an earlier time, and would give some explicit 
indication of the error to the user. Processors that fail to detect the error 
will exhibit some undefined behaviour: the tests enable these cases to be 
identified, and allows for documentation of the handling of detected errors. 



2.2.5 CLASS=QUALIT¥ 

These tests are a miscellany of test programs which have as their only common 
feature that they explore in some sense the quality of an implementation. 
The tests include the following, amongst others: 

* tests that can be timed, or used to estimate the performance. 

* tests that have known syntax errors which can be used to inspect 
the diagnostics. 



* tests that establish whether the implementation has a limit 

which is a virtual infinity in some list or recursive production. 
For example a deep nesting of for-loops (but not unreasonable!) 
would see whether there was any limit, perhaps due to a shortage 
of registers on a computer. 

2.2.6 CLASS=EXTENSION 

A final category is CLASS=EXTENSION. These are specific to some convention- 
alized extension approved by the Pascal Users Group, such as the provision 
of an otherwise clause in case statements. In this case, the class in the 
header comment is followed by a sub-class, as in the example: 
{TEST 6.8-1, CLASS=EXTENSION, SUBCLASS CONFORMANCE} 
The subclass gives the purpose of the test according to the previously 
explained classes. 
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3. STRUCTURE OF THE VALIDATION SUITE 

The validation suite as distributed consists of: 

A. Machine -readable files 

1. A header file containing the character set and an explanation 
of the structure of the other files. 

2. A skeleton program, written in Pascal, to operate on the 
final file of tests. 

3. A copy of this document in machine readable form. 

4. A file consisting of the sequence of test programs arranged in 
lexicographic order of their program-number (see section 2.1). 

B. Printed materials 

1. This document. 

2. A printed version of A.l. 



The skeleton program as supplied prints the test programs on the output 
file, but calls a procedure newprogram before listing the start of a program, 
and calls a procedure endprogram after printing the last end of a program. 
These procedures as now supplied simply print a heading and a separator 
respectively. However, users of the suite may write versions of newprogram 
and endprogram that may write programs to different named files, and which 
may initiate jobs in the operating system queues to carry out the tests. 
The two procedures newsuite and endsuite are also provided in case these 
are of use. 



Since newprogram may return a status result, it may also be programmed to 
be selective in its handling of tests. Only conformance tests may be 
selected, or only tests in section 6.3, as required. 



The skeleton program is in standard Pascal, and conforms to the conventions 
of the validation suite (but has no header comment) . It is documented in 
an Appendix. 



4. 



REPORTING THE RESULTS 
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The results of a pass of the validation suite against a Pascal processor 
should be reported in a standard way, illustrated by the schema below. 

PASCAL PROCESSOR IDENTIFICATION (host, computer, origin of processor, 

TEST CONDITIONS (tester, date, test version): version): 

CONFORMANCE TESTS 

Number of tests passed = ? 

Number of tests failed = ? 

Details of failed tests: 

TEST ???? : explanation of why or what 
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DEVIANCE TESTS 

Number of deviations correctly detected = ? 
Number of tests showing true extensions = ? 
Number of tests not detecting erroneous deviations 
Details of extension: 



Details of deviations: 



ERROR-HANDLING 

Number of errors correctly detected = 

Number of errors not detected = ? 

Details of errors not detected: 
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IMPLEMENTATION DEFINED 

Number of tests run = ? 

Number of tests incorrectly handled = ? 

Details of implementation-dependence: 



QUALITY MEASUREMENT 
Number of tests run = ? 
Number of tests incorrectly handled = ? 
Results of tests: 



EXT ENSION S 

Number of tests run = ? 

Extension present = ? 

as above for this extension. 
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Appendix : Documentation of Skeleton Program 

Purpose 

The skeleton program provided is a standard •conforming Pascal program that 
will identify each test in a file of test programs. It is distributed 
with five stubs which are intended for user modification so that the 
program will serve as the parent of an automatic system for running the 
tests. With the large number of tests in the validation suite, such a 
system is important. As distributed the stubs simply print the text of 
the test program. 

Implementation 

If the recipient's Pascal processor will accept upper- and lower-case 
letters, and the ISO standard lexical representation, then the program 
should be able to run directly. If lexical substitutions are necessary, 
these should be made. No lines approach the limiting length of 72 closely, 
so some expansion room is possible. If only one case of letters is 
available for the source text, then the whole program should be upper-cased 
with the exception of the character constants in the main program and the 
procedure convert. If however, the Pascal processor is also limited to 
upper-case characters in the char type, these too will have to be converted, 
and the whole of the validation suite will have to be converted to upper- 
case alone before the program will run. 



Modification 

Once the recipient has verified that he has the skeleton working correctly, 
it can be modified to other purposes. If the only use desired is the 
construction of many individual files, each with a single test program, 
then newsuite and endsuite may be made dummy procedures. Procedure 
newprogram can open (rewrite) a file with the converted name supplied, 
which is guaranteed unique, leaving processline to write the text to this 
file and endprogram to do any necessary closing of the file. 



13 



CO 
O 



Alternatively, the program may be modified to construct a job deck 
including job control statements. The newprogram procedure will have 
some more complex actions to take, and the endprogram procedure will 
initiate the job into the operating system queues. In the event that 
the user wants to batch up the tests in lots of 20 or so, the access to 
the variable count allows newprogram and endprogram to take appropriate 
action every twentieth test. Or again, if the whole lot is to be batched 
or submitted as a simulated time-sharing job, the newsuite and endsuite 
programs can be used to initialize and initiate. 
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Additionally, the newprogram procedure is given access to the test program 
name and its class. Specially tailored programs can be written to only 
initiate conformance tests, or only conformance tests relevant to section 
6.5 of the Standard, or whatever the user desires. If necessary, specifi- 
cations could be read in, most easily by a modified version of the newsuite 
procedure. 

System documentation 

The main program alternates between dormant states where it searches for 
the header comment starting a test, and active states where it processes 
lines keeping an eye out for the closing end of the test. When it finds 
a header comment, it extracts the data for passing to the stub procedures 
newprogram and endprogram. 
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The procedure extract does this extraction from the line buffer. It 
essentially assumes correctness of the header syntax. The program name 
is stored in a special record. 



The procedure convert is not necessary to the distributed version apart 
from a demonstrative use. It is provided to convert test program numbers 
from numeric format (eg. 6.2.8-4) to an alphabetic format suitable as an 
identifier or file name (e.g. t6p2p8d4) . It switches the format in the 
name record from whatever it is to the alternative format. The format 
as supplied to newprogram is digitized. 

The procedure readaline does simply that. The line is stored in an 
internal buffer line. 
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The procedures newprogram and endprogram have value parameters with 
exactly the same name as their global counterparts. This is to hide 
the global variables from them and provide some measure of robustness 
against errors. The status parameter of newprogram is listed explicitly 
to emphasize the possible change of value. 



There are few features of Pascal in the program that may not be imple- 
mented. There are two goto statements leading to a disaster-exit label; 
if non-local gotos are not implemented the gotos may be omitted or 
replaced by a halt equivalent. The packing in oharveatype is only 
provided to allow comparisons with character array constants ("strings") . 
All identifiers have been checked for uniqueness over the first eight 
characters, and no non-standard usages have been detected in the program. 
If it is necessary to alter the program to recognize header comments by 
'(*T ! instead of ' {T 1 , some changes will be necessary on two lines of 
the main program. 

Lexical structure of procedures 
main 

readaline 

convert 

extract 

scan 
newsuite* 
endsuite* 
newprogram* 
endprogram* 
processline* 
Notes : 

* user-modifiable stub procedures. 

t a call structure diagram is also provided overleaf. 



Distributed version 

As distributed the skeleton program prints all the test programs, one 
per page, in sequence. The headings simply illustrate some features of 
the package. Warning: this takes a lot of paper, so be prepared. 



Date of documentation 
1979 July 13 



Author 

A.H.J. Sale, University of Tasmania 
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»«* »ttf ft **««**»««**«*»» t »«»«»» »*«*tttf «*«**««* t *****«» t«*«f»*tt*t «*»***» 

This skeleton program is provided to process the file of test 
programs in the validation suite. As supplied, it simply lists 
the test programs in a suitable format, but it is provided with 
stubs which can be modified by users of the suite to select 
individual test programs, classes of programs, or particular 
sub-classes, and to write these to named files or initiate them 
in a job stream. 

The particular stubs of interest are: 
newsuite 

newprogram 

processline 
endprogram 
endsuite 
As supplied these are practically only dummy routines. 

This program is written in Standard Pascal according to the 
ISO Standard. It should compile and run without error if 
its lexical representation is acceptable to your processor. 

(C) Copyright 1979 A. H.J. Sale, University of Tasmania. 

«ft««*ft«»ft*t«««*»»»ii««*«*tft««ft»»ftt««««ft*t»»«*iittitt*«ff«*«»*«t«ftt««*««tt* 

} 

program skeleton( input, output); 

label 999; { used for disaster exits } 

const 



maxnamesize= 
nameover flows 
maxlinesizes 
lineoverflow= 

type 

namesize= 
linesize= 
statustypes 

charvectype= 



20; 

{ size of field in name record } 

21; 

{ maxnamesize + 1 } 

72; 

{ size of line array } 

73; 

{ maxlinesize + 1 } 



1 ..maxnamesize; 

1 . .maxlinesize; 

( dormant , active , terminated ) ; 
{ Is program being processed? } 

packed ar r ay [ names ize] of char; 
{ names } 



APPENDIX 1 
nametype= 

natural = 

linetype= 

loopcontrol= 

classtype= 



PAGE A 1-2 



record 

charvec : charvectype ; 

length : . . maxnamesize ; 

version : ( digitized , alphabetized ) 
end; 
{ used to hold program names } 

0. .maxint; 

{ very common type } 

array[linesize] of char; 
{ used for line buffers } 

( scanning , found , no t found ) ; 

{ for controlling scan loops } 

( conformance , deviance , implementationdef ined , 

er rorhandling , qual i ty , other ) ; 
{ category of test } 
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class: 



status: 



count : 



line: 



linelength: 



nametype ; 

{ name of current program } 

classtype; 

{ category of current program } 

statustype; 

{ current status } 

natural; 

{ program sequence number } 

linetype; 

{ the line buffer } 

0. .maxlinesize; 

{ holds actual number of chars in line } 
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procedure readaline; 

{ Reads an input line } 

var 

i : O..lineoverflow; 
ch: char; 
begin 

if eof( input) then begin 
writeln( output) ; 

writ eln( output,' ***«ERROR IN READALINE - HIT EOF»); 
goto 999 
end else begin 
i:=0; 

while not eoln( input) do begin 
i:=i+1; 

if (i > maxlinesize) then begin 
writeln( output) ; 

writ eln( output,' **««ERROR IN READALINE, LONG LINE'); 
goto 999 
end; 

read( input , lineC i] ) 
end; 

read ( input, ch ) ; { disposing of the line marker } 
linelength:=i 

{ Textfiles must have eoln before eof } 
end 
end; { of procedure readaline } 
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procedure convert (var name:nametype) ; 

{ This procedure exchanges the representation of the name 
between digitized (eg 6.2-1) and alphabetized (eg t6p2d1). 
It inspects the version code and reverses it. } 

var 

i : linesize; 

ch: char; 
begin 
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if (name. version = digitized) then begin 
{ We need to alphabetize the name } 
{ Extract assures that digitized length never exceeds 

maxnamesize-1 , so leaving one char expansion space. } 
for i:= name. length downto 1 do begin 
case name.charvec[i] of 
'.♦: ch:= , p , j 
»-*: chrr'd'; 

•o'.M'.^vav^vsvevTvsv^: 

ch : =name . charvec [ i ] 

end; 

name.charvec[i+1] :=ch 
end; 

namccharvecLl^s't' ; 
{ Name is converted } 
name . length : =name . length* 1 ; 
name . version : =alphabetized 

end else begin { version = alphabetized } 
{ We need to digitize the name } 
for i:=2 to name. length do begin 
case name.charvec[i] of 
'p': ch:='.'; 
•d': chir'-'; 

•ov'i V2V3 1 /^ysvevTVSvg 1 : 

ch : =name . charvec Li] 

end; 

name . charvec [ i- 1 ] : =ch 
end; 

name. charvec [ name. length] :=' '; 
{ Name is converted } 
name . length : =name . length- 1 ; 
name . version : =digitized 
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end { of if } 
end; { of procedure convert } 
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procedure extract; 

{ This procedure extracts the program-number and class from the 
header comment of a test program. It sets global parameters 
name and class. There is some simple error- handling in the 
procedure, but it is generally assumed that the header 
comments conform to the syntax. The error-handling is just 
in case. } 



i, 

isave : 1 . . lineoverf low; 

lengthofname, 

k: names ize; 



{ used to scan the line } 

{ used to save value of i } 

{ holds length of name found } 

{ used to fill name } 



procedure scan(lowch,highch:char) ; 

{ Scan moves the index i along the line until it finds 
a character lying between lowch and highch inclusive. 
It includes some simple error- handling which terminates 
the program. } 



state : loopcontrol; 

begin 

{ Set loop to scan forwards } 

state := scanning ; 

{ Loop invariant R1 = 

"characters from line[initial i] to line[i-1] are 
not in the desired subrange." } 
while (state = scanning) do begin 
if (i > linelength) then begin 
{ No more to go, so get out } 
state: mot found 
end else if (line[i] >= lowch) and Qine[i] <= highch) 
then begin 
state :=found 
end else begin { Char is not in range } 

i:=i+1 
end { of if } 
end; { of while } 

if (state = not found) then begin 

writeln( output) ; 

writeln( output/ ««»«ERROR IN SCAN - REACHED LINE END'); 

goto 999 { in outer block and give up } 
end; 



{ Return, leaving i at found character } 
end; { of procedure scan } 
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begin { of extract } 

{ Start scanning at 1 even though we know it begins * {T* 

i: = 1; 

{ Scan until we find a digit } 

scan( , 0» , *9'); 

{ Now assured of a digit so save the index, and look for 

the closing comma } 
isave :=i; 
scan( ',',','); 

{ In case spaces between number and comma } 
while (line[i-1] = » » ) do i:=i-1; 
{ Fill in the discovered name } 
lengthofname :=i- isave; 
if (lengthofname >= maxnamesize) then begin 

lengthofname : =maxnamesize- 1 
end; 
for k:=1 to lengthofname do begin 

name . charvec[ k] : =line[ isave+k- 1 ] 
end; 

{ Space-fill so as to allow string comparisons } 
for k:=(lengthofname+1) to maxnamesize do begin 

namccharvecCk]:* 1 • 
end; 

{ And fill in the rest of the record } 
name . length : =leng thof name ; 
name . version : ^digitized ; 

{ Now scan for the »=• sign that precedes the class } 

scan('s •,*»'); 

{ And an alphabetic character following. The test may 
also let through some non-alphabetics, but no matter. } 

scan( f AVZ'); 

{ Identify the class by its first letter. It is always 
upper-case . } 

then class := conformance 

'D') then class :=deviance 

•E 1 ) then class :=errorhandling 

•I 1 ) then class :=implementationdefined 

•Q 1 ) then class :=quality 
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if (line[i] = »C 
else if (lineCi] 
else if (line[i] 
else if (lineCi] 
else if (lineCi] 
else begin 

{ Error, not recognized } 

writ eln( output); 

writeln( output, 1 **»*ERROR IN EXTRACT - WHAT CLASS? 1 ); 

class :=other { default } 
end; 



{ Now we have established the desired values, so return } 
end; { of procedure extract } 
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procedure newsuite; 

{ This procedure may be used to initialize the run somehow, or to 
read in some parameters for the process. } 

begin 

writeln(output,' THIS IS AN EXECUTION OF THE SKELETON f , 
•VALIDATION SUITE PROCESSOR 1 ); 

writeln( output , • • , 

• . ) . 

page (output) 
end; { of procedure newsuite } 



procedure endsuite; 

{ This procedure may be used to initiate a global job, or 
to check correct completion. } 



begin 

writeln( output, 1 SKELETON VALIDATION SUITE PROCESSOR END 1 , 
• (\ count :4,» TESTS READ)») 
end; { of procedure endsuite } 
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procedure newprogram(name : 
class: 
count: 
var status: 
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name type ; 
classtype; 
natural; 
statustype); 



{ This procedure is called at the recognition of a header 
comment while in dormant status. The first two parameters 
are derived from the header comment, while the third is 
simply the ordinal number of the test met in processing. 
The final parameter is the status of the search. 

The user*s version has the responsibility of deciding what 
to do about this program by setting status to active or 
leaving it passive. In the first case all lines are processed 
by processline later, and the user may set up any headers, 
JCL statements, etc, beforehand. In the latter case the 
driver resumes searching for a header comment. 

The name may be in digitized or alphabetized version - see 
procedure convert. Searching for a particular program can 
be done with a string comparison, for example: 

name.charvec s '6.2-1 • 

Searching for a subsection can be done with string comparisons 
if care is taken with collating sequence. On ASCII machines, 
space collates lower than anything else, so that 

(name.charvec >= '6.2 f ) and 

( name . charvec < • 6 . 3 ' ) 

will determine all tests relevant to section 6.2 and its 
subsections. 

The class may also be used in selection. 

The count may be used to parcel up say 20 tests and run them 
in a batch, rather than the whole shebang at one go. An 
appropriate test is 

if ((count mod 20) s 0) then ... 
although this may be more appropriately used in endprogram. 
} 
var 

i : linesize; 
begin 

write(output,» TEST PROGRAM •); 

if (name. version = alphabetized) then convert (name); 

for i:=1 to name. length do write(output,name.charvec[i]); 

writ e( output, 1 (ALIAS »); 

con vert (name); 

for i:=1 to name. length do wr ite( output, name. charvec[i]) ; 

writ eln( out put,'), NO' , count: 4); 

writ eln( output) ; 

writ eln( output) ; 

status :=active { forcing print of all } 
end; { of procedure newprogram } 
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procedure endprogram(name: 
class: 
count: 
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nametype ; 

classtype; 

natural); 



{ See the comments for newprogram. 
Endprogram can do exactly the same tests, but it has no 
responsibility for status which will automatically 
become dormant afterwards. } 

begin 

page (output) 
end; { of procedure endprogram } 



procedure processline; 

{ This procedure processes a source line of text, whatever 
that implies. Here we just print it. } 

var 

i : linesize; 
begin 

write (out put, 1 *); 

for i:=1 to linelength do write(output,line[i]); 

writ eln( output ) 
end; { of procedure processline } 



begin { of Main Program } 

count :=0; 
status : sdormant ; 



newsuite; 



{ Call in case user needs prologue } 



terminated } 



repeat begin { until status 
readaline; 
if (status a dormant) then begin 

{ We only look for header comments } 
if (linelength >= 2) then begin 

if (line[1 ] = '{*) and (line[2] s 
extract ; 
if (name.charvec = »999 

status : = terminated 
end else begin 
count :=count+1; 

{ Newprogram may alter status too } 
newprogram (name, class, count, status) 
end 
end 
end 
end; { having possibly processed a header } 
{ If dormant we won't do anything now } 
if (status s active) then begin 
processline; 

if (linelength >= 4) then begin 
if (lined] = 'e') and 
(line[2] = f n») and 
(line[3] = 'd*) and 
(line[4] = '.«) then begin 
endprogram ( name , class , count ) ; 
status : = dormant 
end 
end 
end 
end until (status = terminated); 
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• ) then begin 
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endsuite; 



{ Call in case user needs epilogue } 



999: 
end. 



CD 



ro 



TEST 5.2.2-1, CLASS=QUALITY} 
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This program does not conform to the standard because its 
meaning is altered by the truncation of its identifiers to 8 
characters. Does the processor provide any indication that the 
program does not conform? 

Such surreptitious changes of meaning are dangerous. 
Obviously processors with 8-character significance will have 
difficulty in detecting such problems, but it can be done. 
For processors with full significance it is easier. } 

•rogram t5p2p2dl (output) ; 
onst 

valueofaverylongidenti fieri =10; 
irocedure p; 
ar 

val ueofaverylong identi fier2 : integer ; 
eg in 

val ueofaverylong identified: =11; 
if val ueofaverylong identi fieri O 
val ueofaverylong identi fier2 then 
writeln(* IDENTIFIERS DISTINGUISHED 
else 

writeln(* IDENTIFIERS NOT DISTINGUISHED, 
nd; 

•eg in 

P 
nd. 



5. 2. 2-1' ) 

5.2.2-1') 



00000100 
000*00200 
00000300 
00000400 
00000500 
00000600 
00000700 
00000800 
00000900 
00001000 
00001100 
00001200 
00001300 
00001400 
00001500 
00001 600 
00001700 
00001800 
00001900 
00002000 
00002100 
00002200 
00002300 
00002400 
00002500 
00002600 
00002700 
00002800 
00002900 
00003000 
00003100 
00003200 
00003300 
00003400 
00003500 
00003600 
00003700 
00003800 
00003900 
00004000 
00004100 
00004200 
00004300 
00004400 
00004500 
00004600 
00004700 
00004800 
00004900 
00005000 
00005100 
00005200 
00005300 
00005400 



{TEST 6.1.2-1, CLASS=DEVTANCE} 

{ This test checks that nil is implemented as a reserved 
word, as it should be. The compiler deviates if the program compiles 
and prints DEVIATES. } 

program t6plp2dl (output) ; 
var 

i: (tick, cross, nil); 
begin 

i:=nil; 

writelnC DEVIATES. . .6.1.2-1, NIL 1 ) 
end. 



{TEST 6.1.2-2, CLASS=DEVTANCE} 

{ This test checks that reserved words cannot in fact be redefined. 
The compiler deviates if the program compiles and prints DEVIATES} 

program t6plp2d2 (output) ; 
var 

thing : (var ,str ing) ; 
begin 

thing :=st ring; 

writelnC DEVIATES. ..6.1.2-2, RESERVED WORDS 1 ) 
end. 



{TEST 6.1.2-3, CLASS=CCNFORMANCE} 

{ This test checks the implementation of identifiers 
and reserved words to see that the two are correctly distinguished. 
The compiler fails if the program does not compile and 
print PASS. } 

program t6plp2d3 (output) ; 
var 

procedurex ,procedurf ,procedur :char ; 

f unctionx ,f unctiom,f unctio : integer; 

iffyrboolean; 
begin 

procedurex^'0 1 ; 

procedurf r^'l 1 ; 

procedur^^ 1 ; 

functionx:=0; 

functiom:=l; 

f unctio: =2; 

iffy:=true; 

writelnC PASS. . .6.1.2-3, IDENTIFIERS 1 ) 
end. 



00005500 
00005600 
00005700 
00005800 
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00006000 
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00006200 
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00006500 
00006600 
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00006900 
00007000 
00007100 
00007200 
00007300 
00007400 
00007500 
00007600 
00007700 
00007800 
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00008000 
00008100 
00008200 
00008300 
00008400 
00008500 
00008600 
00008700 
00008800 
00008900 
00009000 
00009100 
00009200 
00009300 
00009400 
00009500 
00009600 
00009700 
00009800 
00009900 
00010000 
00010100 
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{TEST 6.1.3-1, CLASS=CONFORMANCE} 

{ The Pascal Standard permits identifiers to be of any length 
This test will simply print out 'PASS* if the compiler accepts 
identifiers of lengths up to 70 characters. } 

program t6plp3dl (output) ; 
const 

ilOiiiiiii = 10; 

i20iiiiiiiiiiiiiiiii = 20; 

i30iiiiiiiiiiiiiiiiiiiiiiiiiii = 30; 

i40iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii = 40; 

i50iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii = 50; 

i60iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii = 60; 
i70iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii 

= 70; 

begin 

if ilOiiiiiii + i20iiiiiiiiiiiiiiiii + 

i30iiiiiiiiiiiiiiiiiiiiiiiiiii + 

i40iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii + 

i50iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii + 

i60iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii + 
i70iiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii 

O 280 then 

writeln(* FAIL. ..6.1.3-1') 
else 

writeln(* PASS. ..6.1. 3-1') 
end. 



{TEST 6.1.3-2, CLASS=€ONFCRMANCE} 

{ The Pascal Standard states that matching upper and lower 
case letters are equivalent in identifiers and word-symbols 
(i.e. reserved words) if they are permitted. If this is the 
case for this compiler, then the program shall print 'PASS 1 . 
The compiler fails if the program cannot be compiled. 
This test is irrelevant for one case compilers. } 

program t6plp3d2 (output) ; 
var 

conform : integer; 



Begin 




BEGIN 




Conform :=1; 




CONFORM: =2; 




If conform = 


2 then 


writelnC 


PASS.. 


enD 




end. 





.6.1.3-2') 



00010200 
00010300 
0001.0400 
00010500 
00010600 
00010700 
00010800 
00010900 
00011000 
00011100 
00011200 
00011300 
00011400 
00011500 
00011600 
00011700 
00011800 
00011900 
00012000 
00012100 
00012200 
00012300 
00012400 
00012500 
00012600 
00012700 
00012800 
00012900 
00013000 



00013100 
00013200 
00013300 
00013400 
00013500 
00013600 
00013700 
00013800 
00013900 
00014000 
00014100 
00014200 
00014300 
00014400 
00014500 
00014600 
00014700 
00014800 
00014900 
00015000 
00015100 



{TEST 6.1.3-3, CLASS=QUALITY} 

{ Although the Standard places no limit on the LENGTH of 
identifiers, they must be UNIQUE in at least the first 8 
characters. This program will determine the significance 
of identifiers from 3 characters to 20 characters. 
This program is of course non-standard, and relies on scope 
masquerades. It assumes a naive significance limit exists, 
or that there is none. Some compilers may violate the assumption 
by hashing an identifier tail or preserving the real length. } 

program t6plp3d3 (output) ; 
const 

i3i - 3; 

i4ii = 1; 

i5iii = 1; 

i6iiii « 1; 

i7iiiii = 1; 

i8iiiiii = 1; 

i9iiiiiii = 1; 

ilOiiiiiii = 1; 

illiiiiiiii = 1; 

il2iiiiiiiii = 1; 

il3iiiiiiiiii = 1; 

il4iiiiiiiiiii = 1; 

il5iiiiiiiiiiii = 1; 

il6iiiiiiiiiiiii = 1; 

il7iiiiiiiiiiiiii = 1; 

il8iiiiiiiiiiiiiii = 1; 

il9iiiiiiiiiiiiiiii = 1; 

i 20 iiiiiiiiiiiiiiiii = 1; 

procedure signif; 
const 

i3j = 0; 

i4ij = 0; 

i5iij = 0; 

i6iiij = 0; 

i7iiiij = 0; 

i8iiiiij = 0; 

i9iiiiiij = 0; 

ilOiiiiiij = 0; 

illiiiiiiij = 0; 

il2iiiiiiiij = 0; 

il3iiiiiiiiij = 0; 

il4iiiiiiiiiij = 0; 

il5iiiiiiiiiiij = 0; 

il6iiiiiiiiiiiij = 0; 

il7iiiiiiiiiiiiij = 0; 

il8iiiiiiiiiiiiiij = 0; 

il9iiiiiiiiiiiiiiij = 0; 

i20iiiiiiiiiiiiiiiij = 0; 

var 

x : integer; 
begin 

x:=i3i + i4ii + i5iii + i6iiii + i7iiiii + iSiiiiii + 
i9iiiiiii + ilOiiiiiii + illiiiiiiii + il2iiiiiiiii + 
il3iiiiiiiiii + il4i iiiiiiiiii + ilSiiiiiiiiiiii + 
il6iiiiiiiiiiiii + il7ii iiiiii iiiiii + il8iiiiiiiiiiiiiii + 
il9iiiiiiiiiiiiiiii + i20iiiiiiiiiiiiiiiii; 
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00015200 g 

00015300 GO 

00015400 Q 

00015500 f^ 

00015600 

00015700 ^ 

00015800 y 

00015900 

00016000 

00016100 

00016200 

00016300 

00016400 

00016500 

00016600 

00016700 

00016800 

00016900 

00017000 

00017100 

00017200 

00017300 

00017400 

00017500 

00017600 

00017700 
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00017900 
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00018100 

00018200 

00018300 

00018400 

00018500 

00018600 

00018700 

00018800 

00018900 

00019000 

00019100 

00019200 

00019300 

00019400 

00019500 

00019600 

00019700 

00019800 

00019900 

00020000 

00020100 

00020200 

00020300 

00020400 

00020500 

00020600 

00020700 

00020800 

00020900 

00021000 

00021100 

00021200 



O 
O 



O 
DO 



TO 






CD 



r\5 



if x * 20 then 

writelnC NUMBER OF SIGNIFICANT CHARACTERS >= 20*) 
else 

writelnC NUMBER OF SIGNIFICANT CHARACTERS = ' , x) 
end; 

begin 

signif; 
end. 



{TEST 6.1.5-1, CLASS=CCNFCRMANCE} 

{ This program tests the conformance of the compiler to 
the syntax productions for numbers specified by the 
Pascal Standard. 

If all productions are permitted the program will 
print 'PASS*. The compiler fails if the program will 
not compile. } 

program t6plp5dl (output) ; 

const 

{'all cases are legal productions } 

a » 1; 

b = 12; 

c = 0123; 

d = 123.0123; 

e = 123.0123E+2; 

f = 123.0123E-2; 

g = 123.0123E2; 

h = 123E+2; 

i = 0123E-2; 

j = 0123E2; 



begin 

writelnC PASS, 
end. 



.6.1.5-1') 



88811188 

00021500 
00021600 
00021700 
00021800 
00021900 
00022000 
00022100 
00022200 



00022300 
00022400 
00022500 
00022600 
00022700 
00022800 
00022900 
00023000 
00023100 
00023200 
00023300 
00023400 
00023500 
00023600 
00023700 
00023800 
00023900 
00024000 
00024100 
00024200 
00024300 
00024400 
00024500 
00024600 
00024700 
00024800 
00024900 



{TEST 6.1.5-3, CLASS=DEVIANCE} 

{ The number productions specified in the Pascal Standard 
clearly state that a decimal point must be preceded by 
a digit sequence. 

The compiler deviates if the program compiles, in which case 
the program will print 'DEVIATES', or if one of the cases is 
accepted . 
The compiler conforms if all the cases are rejected. } 

program t6plp5d3 (output) ; 
const 

r = .123; 
var 

i : real; 
begin 

i:=.123; 

i:=-.123; 

writelnC DEVIATES... 6. 1. 5-3' ) ; 
end. 



{TEST 6.1.5-4, CLASS=DEVIANCE} 

{ The number productions specified in the Pascal Standard 
clearly state that a decimal point must be followed by 
a digit sequence. 

The compiler deviates if the program compiles, in which case 
the program will print •DEVIATES 1 . 
The compiler conforms if the program fails to compile. } 

program t6plp5d4 (output) ; 
var 

i : real; 

begin 

i:=0123.; 

writelnC DEVIATES. ..6.1.5-4'); 
end. 
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00026100 > 

00026200 <£> 

00026300 ;j> 

00026400 I— 

00026500 

00026600 

00026700 

00026800 

00026900 *tfc 

00027000 

00027100 

00027200 

00027300 

00027400 

00027500 

00027600 

00027700 

00027800 

00027900 
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00028100 
00028200 
00028300 
00028400 
00028500 
00028600 
00028700 
00028800 
00028900 
00029000 
00029100 
00029200 
00029300 
00029400 
00029500 
00029600 
00029700 
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{TEST 6.1.5-2, CLASS=C0NF0RMANCE} 

{ This program simply tests if very long numbers are permitted. 
The value should be representable despite its length. } 

program t6plp5d2 (output) ; 
const 

reel * 123.456789012345678901234567890123456789; 
begin 

writelnC PASS... 6. 1.5-2') 
end. 



00025000 
00025100 
00025200 
00025300 
00025400 
00025500 
00025600 
00025700 
00025800 
00025900 
00026000 



{TEST 6.1.5-5, CLASS=DEVIANCE} 

{ Spaces in numbers are forbidden by the Pascal Standard 
This includes spaces around '.' and *E'. The compiler 
deviates if ONE or MORE of the cases below are accepted. 
The compiler conforms if ALL cases are rejected. } 

program t6plp5d5 (output) ; 
const 

one = 1 234; 

two =0 .1234; 

three = 0. 1234; 

four = 1234 E2; 

five = 1234E 2; 

six = 1234E- 2; 

seven = 1234E+ 2; 
begin 

writelnC DEVIATES. . .6. 1. 5-5 1 ) 
end. 



00029800 
00029900 
00030000 
00030100 
00030200 
00030300 
00030400 
00030500 
00030600 
00030700 
00030800 
00030900 
00031000 
00031100 
00031200 
00031300 
00031400 
00031500 
00031600 



> 
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{TEST 6.1.5-6, CLASS=DEVIANCE} 

{ The Pascal standard allows equivalence of upper and 
lower-case letters in names and reserved words only. 
Will the compiler accept 'e' as equivalent to 'E'? 
It should not. The test is not relevant 
to one-case processors. } 

program t6plp5d6 (output) ; 
var 

i : real; 
begin 

i:=123e2; 

writelnC DEVIATES. . .6.1.5-6') 
end. 



{TEST 6.1.6-1, CIASS=<:ONFORMANCE} 

{ Labels are permitted in standard Pascal. This program 
simply tests if they are permitted by this compiler. 
The compiler fails if the program will not compile 
(or the message printed out is incorrect) . } 

program t6plp6dl (output) ; 
label 

1,2,3,4,5; 

begin 

writeC P'); 

goto 4; 
1: write(' .6'); 

goto 5; 
2: write( , SS l ); 

goto 3; 
3: writer.. 1 ); 

goto 1; 
4: write( , A'); 

goto 2; 
5: writelnC. 1.6-1'); 
end. 



{TEST 6.1.6-2, CLASS=<:ONFORMANCE} 

{ Labels should be distinguished by their apparent integral value 
according to the Pascal Standard. 

This program tests if this is the case for this compiler. If so 
then the program shall print PASS. } 

program t6plp6d2 (output) ; 
label 

5,6,7; 
begin 

goto 5; 
0006: goto 7; 
5: goto 6; 
007: writeln('PASS...6.1.6-2') 
end. 



00031700 
00031300 

00031900 
00032000 
00032100 
00032200 
00032300 
00032400 
00032500 
00032600 
00032700 
00032800 
00032900 
00033000 
00033100 



00033200 
00033300 
00033400 
00033500 
00033600 
00033700 
00033800 
00033900 
00034000 
00034100 
00034200 
00034300 
00034400 
00034500 
00034600 
00034700 
00034800 
00034900 
00035000 
00035100 
00035200 
00035300 
00035400 
00035500 



00035600 
00035700 
00035800 
00035900 
00036000 
00036100 
00036200 
00036300 
00036400 
00036500 
00036600 
00036700 
00036800 
00036900 
00037000 
00037100 



{TEST 6.1.7-1, CLASS=CONFORMANCE} 

{ Character strings consisting of a single character 
are the constants of the standard type char. This 
program simply tests that these are permitted by 
the compiler. 
The compiler fails if the program will not compile. } 

program t6plp7dl (output) ; 
const 

one = '1'; 
two = »2'; 
var 

two too : char; 
begin 

if (one <> two) and (two = *2') then 
begin 

twotoo:='2'; 
if two too = two then 

writelnC PASS. . .6.1. 7-1 •) 
else 

writelnC FAIL. . .6.1.7-1 ') 
end 
else 

writelnC FAIL. . .6.1. 7-1') 
end. 



{TEST 6.1.7-2, CLASS=C0NF0RMANCE} 

{ The Pascal standard does not place an upper limit 
on the length of strings. This program tests if strings 
are permitted up to a length of 68 characters. The 
compiler fails if the program will not compile. } 

program t6plp7d2 (output) ; 
type 

stringl = packed array[1..68] of char; 

string2 = packed array[1..33] of char; 
var 

alpha : stringl; 

i : string2; 

begin 

alpha := 

» ABCDEFGHI JKLN!btoPQRSTU\to&«ZABCDEFGH^ ' i 

i:='IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII»; 

writelnC PASS. . .6.1.7-2') 
end. 



00037200 : 

00037300 £ 

00037400 * 

00037500 F 

00037600 - 

00037700 f 

00037800 = 

00037900 C 

00038000 s 

00038100 \ 

00038200 

00038300 

00038400 

00038500 

00038600 

00038700 

00038800 

00038900 

00039000 

00039100 

00039200 

00039300 

00039400 

00039500 

00039600 

00039700 



00039800 
00039900 
00040000 
00040100 
00040200 
00040300 
00040400 
00040500 
00040600 
00040700 
00040800 
00040900 
00041000 
00041100 
00041200 
00041300 
00041400 
00041500 
00041600 
00041700 



{TEST 6.1.7-3, CLASS=CONFORMANCE} 

{ The Pascal standard allows quotes to appear as char 
constants and permits them to appear in strings. 
If this is desired, they must be written twice. 
This program tests that the compiler will allow this. 
The compiler fails if the program will not compile. } 

program t6plp7d3 (output) ; 
const 

quote = • ■ • • . 

strquote = 'CA^'T'; 
begin 

writelnC PASS. ..6.1. 7-3') 
end. 



{TEST 6.1.7-4, CLASS=DEVTANCE} 

{ This program tests that strings of different lengths are 
not compatible (i.e. l..m and l..n). 
The compiler fails if the program compiles. } 

program t6plp7d4 (output) ; 
const 

stringl = 'STRING1'; 
var 

string2 : packed array[1..5] of char; 
begin 

string2:=stringl; 

writelnC DEVIATES. ..6.1.7-4') 
end. 



{TEST 6.1.7-5, CLASS=DEVTANCE} 

{ The Pascal Standard specifically states that character 
strings are constants of the type 

packed array[l..n] of char 
This program tests that this type is not compatible 
with unpacked arrays. 
The compiler conforms if the program fails to compile. } 

program t6plp7d5 (output) ; 
var 

stringl : packed array[1..4] of char; 

string2 : array[1..4] of char; 
begin 

stringl :=»STR1' ; 

string2:=»STR2'; 

writelnC DEVIATES. ..6. 1.7-5') 
end. 



00041800 
00041900 
00042000 
00042100 
00042200 
00042300 
00042400 
00042500 
00042600 
00042700 
00042800 
00042900 
00043000 
00043100 
00043200 
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00043400 
00043500 
00043600 
00043700 
00043800 
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00044000 
00044100 
00044200 
00044300 
00044400 
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00044800 
00044900 
00045000 
00045100 
00045200 
00045300 
00045400 
00045500 
00045600 
00045700 
00045800 
00045900 
00046000 
00046100 
00046200 
00046300 
00046400 
00046500 



{TEST 6.1.7-6, CIASS=DEVIANCE} 

{ Again, a character string is a constant of the type 
packed array[l..n] of char. 
This program tests that strings are not compatible 
with bounds other than l..n. 
The compiler conforms if the program fails to compile. } 

program t6plp7d6 (output) ; 
var 

stringl : packed array[1..4] of char; 

string2 : packed array [0.. 3] of char; 

string3 : packed array[2..5] of char; 
begin 

stringl :='STR1'; 



string2:= , STR2'; 
string3:='STR3'; 
writelnC DEVIATES. 



.6.1.7-6') 



end. 



{TEST 6.1.7-7, CLASS=DEVTANCE} 

{ Again, as character strings are constants of the type 
packed array [l..n] of char, 
they should not be compatible with packed arrays of 
subranges of char. 
The compiler conforms if the program will not compile. } 

program t6plp7d7 (output) ; 
type 

alpha = »A'..'Z'; 
var 

stringl : packed array[1..4] of char; 

string2 : packed array[1..4] of alpha; 
begin 

stringl: = 'FOUR'; 

string2:= , F0UR'; 

writelnC DEVIATES. . .6.1.7-7') 
end. 
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{TEST 6.1.7-8, CLASS=DEVIANCE} 

{ Similarly to 6.1,7-7, subranges of char should not be 

compatible with packed arrays of char. However, if the extension 
is allowed, it should be correctly handled. 
Standards conforming processors will not compile the program, 
compilers which permit the extension should detect the error 
at compile- time or run- time, but should not execute without 
error. } 

program t6plp7d8 (output) ; 
type 

digit = , , .. , 9 I ; 
var 

stringl : packed array[1..4] of char; 

string2 : packed array[1..4] of digit; 
begin 

stringl^'FOUR'; 

strir^^'FOUR 1 ; 

writeln(» DEVIATES. ..6.1.7-8*) 
end. 



{TEST 6.1.7-9, CLASS=DEVIANCE} 

{ Some compilers may allow compatibility between strings and char 
constants. The two types for which they are constants are not 
compatible. 

This program tests what the compiler will allow. 
If all cases are accepted the program will print DEVIATES. 
However, if one or more of the cases are accepted, then the 
compiler deviates for those cases. } 

program t6plp7d9 (output) ; 
const 

a = 'A'; 
var 

stringl : 

string2 : 

achar : 
begin 

stringl:=a; 

stringl:= , A l ; 

string2:=a; 

string2:= , A l ; 

achar :=string2; 

stringlr^'A '; 

achar :=stringl; 

stringl:** 1 A 1 ; 

achar :=stringl; 

writelnC DEVIATES 
end. 



packed array[1..4] of char; 
packed array[l..l] of char; 
char; 



{ CASE 
{ CASE 
{ CASE 
{ CASE 
{ CASE 



{ CASE 6 } 

{ CASE 7 } 
.6.1.7-9') 



00050400 
00050500 
00050600 
00050700 
00050800 
00050900 
00051000 
00051100 
00051200 
00051300 
00051400 
00051500 
00051600 
00051700 
00051800 
00051900 
00052000 
00052100 
00052200 
00052300 
00052400 



00052500 
00052600 
00052700 
00052800 
00052900 
00053000 
00053100 
00053200 
00053300 
00053400 
00053500 
00053600 
00053700 
00053800 
00053900 
00054000 
00054100 
00054200 
00054300 
00054400 
00054500 
00054600 
00054700 
00054800 
00054900 
00055000 
00055100 
00055200 
00055300 



{TEST 6.1.7-10, CLASS=DEVTANCE} 

{ The Pascal Standard states that string types are compatible 
if they have the same number of components. 

Some compilers may allow assignment of one string type to another, 
padding out with spaces or truncating characters if they are 
not of the same lengths. 

All the cases below should be strictly rejected. 
The compiler deviates if one or more are accepted. } 

program t6plp7dl0 (output) ; 
var 

stringl : packed array[1..4] of char; 

string2 : packed array[1..6] of char; 
begin 

writelnC DEVIATES.. 

stringl :='AB'; 

writeln('CASE 1 : ' 

stringl : = 'ABCD'; 

string2:=stringl; 

writeln('CASE 2 : ' 

stringl:='ABCDEFG'; 

writelnC CASE 3 : ' 
end. 



.6.1.7-10'); 

{ 1-pad with spaces ? } 
, stringl); 

{ 2-what happens here ? } 
, string2); 

{ 3-what happens here ? } 
, stringl) 



{TEST 6.1.7-11, CLASS=DEVTANCE} 

{ The Pascal Standard says that a character string is a sequence of 
characters enclosed by apostrophes, consequently there is no 
NULL string. Does the compiler allow this in programs. 
The compiler conforms if the program does not compile. } 

program t6plp7dll (output) ; 
begin 

writelnC ': 20); 

writelnC DEVIATES. ..6.1.7-11') 
end. 



{TEST 6.1.8-1, CLASS=CONFORMANCE} 

{ The Pascal Standard states that a comment is considered to 
be a token separator. This program tests if the compiler 
allows this. 
The compiler fails if the program cannot be compiled. } 

program{ Is this permitted to be here? }t6plp8dl (output) { Or here? }; 
var 

i{ control variable }:{ colon }integer{ type }; 
begin 

for{ This is a FOR loop }i{ control variable } :={ assignment } 
1{ initial value }to{ STEP 1 UNTIL }1{ repetitions }do{ go } 
writeln{ write statement }(' PASS. . .6.1. 8-1") 
end. 
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{TEST 6.1.8-2, CIASS=CONFORMANCE} 

{ The Pascal Standard permits an open curly bracket to 
appear in a comment. This program tests that the 
compiler will allow this. 
The compiler fails if the program will not compile. } 

program t6plp8d2 (output) ; 
begin 

{ Is a { permitted in a comment? } 

writelnC PASS... 6. 1.8-2') 
end. 



{TEST 6.1.8-3, CLASS=CONFORMANCE} 

{ This program tests that if the compiler allows both 
forms of comments, must the delimiters be the same. 
If only one form of comment is permitted, the test is not relevant. 

program t6plp8d3 (output) ; 
begin 

{ This is a standard comment } 

(* This is an alternative form *) 

{ What will happen here? *) } 

(* Or here? } *) 

writelnC PASS. . .6.1.8-3') 
end. 



{TEST 6.1.8-4, CLASS=QUALITY} 

{ In the case of an unclosed comment, does the compiler help 
the programmer to detect that this is so ? Hard to trace run-time 
errors may occur if a comment accidentally encloses 1 or more 
statements. } 

program t6plp8d4 (output) ; 
var 

i : integer; 
begin 

i:=10; 

{ Now write out the value of i. 

writelnC THE VALUE OF I IS:', i) ; 

{ The value of i will not be printed because of the unclosed 
previous comment. } 

i:=0 
end. 



00060500 
00060600 
00060700 
00060800 
00060900 
00061000 
00061100 
00061200 
00061300 
00061400 
00061500 
00061600 



00061700 
00061800 
00061900 
00062000 
} 00062100 
00062200 
00062300 
00062400 
00062500 
00062600 
00062700 
00062800 
00062900 
00063000 



00063100 
00063200 
00063300 
00063400 
00063500 
00063600 
00063700 
00063800 
00063900 
00064000 
00064100 
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00064400 
00064500 
00064600 
00064700 
00064800 



{TEST 6.1.8-5, CLASS=DEVIANCE} 

{ Nested comments are not permitted in Pascal and hence 

this program should not compile. The compiler deviates if the 
program compiles and prints DEVIATES. } 

program t6plp8d5 (output) ; 
begin 

{ writelnC RAN') 

{ writelnC RANI 1 ) } 

writeln(» RAN2') } 

writelnC DEVIATES. . .6.1.8-5, NESTED COMMENTS 1 ) 
end. 



{TEST 6.2.1-1, CLASS=C0NF0RMANCE} 

{ This program includes a sample of each declaration 
part in its minimal form. Every possibility is covered elsewhere 
in the validation suite, but the test is made here. } 

program t6p2pldl (output) ; 
label 

1; 
const 

one = 1; 
type 

small = 1..3; 
var 

tiny : small; 
procedure p(var x : small); 
begin 

x:=l 
end; 
begin 

goto 1; 
1: p(tiny); 

if (tiny = one) then 

writelnC PASS. ..6.2. 1-1') 
end. 
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{TEST 6.2.1-2, CLASS=CONFORMANCE} 00068700 

00068800 

{ This program checks that multiple repetitions are possible 00068900 

in the declaration parts, and is provided as a check. Practically 00069000 

all occurrences will re-appear elsewhere in the validation 00069100 

suite. } 00069200 

00069300 

program t6p2pld2 (output) ; 00069400 

label 00069500 

1,2,3; 00069600 

const 00069700 

one=l; 00069800 

two=2; 00069900 

three=3; 00070000 

type 00070100 

small = 1..3; 00070200 

larger = 1..10; 00070300 

biggest = 1..100; 00070400 

var 00070500 

tiny : small; 00070600 

soso : larger; 00070700 

big : biggest; 00070800 

procedure p(var x : small); 00070900 

begin 00071000 

x:=l 00071100 

end; 00071200 

procedure q(var y : larger); 00071300 

begin 00071400 

y:=2 00071500 

end; 00071600 

procedure r(var z : biggest); 00071700 

begin 00071800 

z:=3 00071900 

end; 00072000 

begin 00072100 

p(tiny); goto 2; 00072200 

1: r(big); goto 3; 00072300 

2: q(soso); goto 1; 00072400 

3: if (tiny=one) and (soso=two) and (big=three) then 00072500 

writelnC PASS. ..6. 2.1-2* ) 0Q072600 

end. 00072700 



{TEST 6.2.1-3, CLASS=DEVIANCE} 

{ Checks to see that labels are not permitted unless 
they have been declared in the heading } 

program t6p2pld3 (output) ; 
begin 

3: writeln( f DEVIATES. ..6.2.1-3') 
end. 
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{TEST 6.2.1-4, CLASS=DEVTANCE} 

{ Checks to see that labels may not be given two sites 
in the executable part. Since the label is not used 
in a goto this program is a stringent test. } 

program t6p2pld4 (output) ; 
label 
9; 
begin 

9: writer DEVIATES*); 
if true <> false then 

9: writeln( , ...6.2.1-4 l ) 
end. 



00073700 Ig 
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00073900 O 
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00074100 
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00074300 S 
00074400 V) 
00074500 
00074600 25 
00074700 CD 
00074800 
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00075000 



{TEST 6.2.1-5, CLASS=DEVTANCE} 

{ This program declares a label, but it is not sited 
nor referenced. This is illegal, as each declared 
label must appear once (and only once) in the executable 
part of the program. } 

program t6p2pld5 (output) ; 
label 

9; 
begin 

writelnC DEVIATES. ..6.2.1-5') 
end. 



{TEST 6.2.1-6, CLASS=CONFORMANCE} 

{ This is the minimal program. } 

program t6p2pld6; 

begin 

end. 
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{TEST 6.2.1-7, CIASS=ERRORHANDLING} 

{ The Pascal Standard states that '..local variables have values 
which are undefined at the beginning of the statement part..'. 
The undefined value is dependent on the implementation. 
Ideally the program should not run. However, if it does, the 
program shall print the value of i, whether it be a system 
initialized value or rubbish left over from procedure q. } 

program t6p2pld7 (output) ; 

procedure q; 
var 

i,j : integer; 
begin 

i:=2; 

j:=3 
end; 

procedure r; 
var 

i : integer; 
begin 

writeln('ERROR NOT DETECTED. . .6.2.1-7: TOE VALUE OF I IS ■ , I) 
end; 

{ Program body } 
begin 

q; 

r 

end. 



77200 
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00077300 
00077400 
00077500 
00077600 
00077700 
00077800 
00077900 
00078000 
00078100 
00078200 
00078300 
00078400 
00078500 
00078600 
00078700 
00078800 
00078900 
00079000 
00079100 
00079200 
00079300 
00079400 
00079500 
00079600 
00079700 
00079800 
00079900 
00080000 
00080100 



{TEST 6.2.1-8, CLASS=QUALITY} 00080200 

00080300 

{ This test checks that a large number of types may be declared 00080400 
in a program. It is an attempt to discover any small limit imposed 00080500 

on the number of types by a compiler. } 00080600 

00080700 

program t6p2pld8 (output) ; 00080800 

type 00080900 

tl = 0..1; 00081000 

t2 = 0..2; 00081100 

t3 = 0..3; 00081200 

t4 = 0..4; 00081300 

t5 = 0..5; 00081400 

t6 = 0..6; 00081500 

t7 = 0..7; 00081600 

t8 = 0..8; 00081700 

t9 = 0..9; 00081800 

tlO = 0..10; 00081900 

til = 0..11; 00082000 

tl2 = 0..12; 00082100 

tl3 = 0..13; 00082200 

tl4 = 0..14; 00082300 

tl5 = 0..15; 00082400 

tl6 = 0..16; 00082500 

tl7 = 0..17; 00082600 

tl8 = 0..18; 00082700 

tl9 = 0..19; 00082800 

t20 = 0..20; 00082900 

t21 = 0..21; 00083000 

t22 = 0..22; 00083100 

t23 = 0..23; 00083200 

t24 = 0..24; 00083300 

t25 = 0..25; 00083400 

t26 = 0..26; 00083500 

t27 = 0..27; 00083600 

t28 = 0..28; 00083700 

t29 = 0..29; 00083800 

t30 = 0..30; 00083900 

t31 = 0..31; 00084000 

t32 - 0..32; 00084100 

t33 = 0..33; 00084200 

t34 = 0..34; 00084300 

t35 = 0..35; 00084400 

t36 = 0..36; 00084500 

t37 = 0..37; 00084600 

t38 = 0..38; 00084700 

t39 = 0..39; 00084800 

t40 = 0..40; 00084900 

t41 = 0..41; 00085000 

t42 = 0..42; 00085100 

t43 = 0..43; 00085200 

t44 = 0..44; 00085300 

t45 = 0..45; 00085400 

t46 = 0..46; 00085500 

t47 = 0..47; 00085600 

t48 = 0..48; 00085700 

t49 = 0..49; 00085800 

t50 = 0..50; 00085900 

var 00086000 

vl : tl; 00086100 

v2 : t2; 00086200 
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v3 : t3 

v4 : t4 

v5 : t5 

v6 : t6 



v7 : 

v8 : 

v9 : 

vlO 

vll 

vl2 

v!3 



t7 

t8 

t9 

: tlO 
: til 
: tl2 
: tl3 



vl4 : tl4 

vl5 : tl5 

vl6 : t.16, 

vl7 : tl7 

vl8 : tl8 

vl9 : tl9, 

v20 : t20 

v21 : t21 

v22 : t22 

v23 : t23 ; 

v24 : t24 

v25 : t25; 

v26 : t26 

v27 : t27 

v28 : t28 

v29 : t29 

v30 : t30 

v31 : t31 

v32 : t32 

v33 : t33 

v34 : t34 

v35 : t35; 

v36 : t36 

v37 : t37 

v38 : t38 

v39 : t39 

v40 : t40 

v41 : t41 

v42 : t42 

v43 : t43 

v44 : t44 

v45 : t45 

v46 : t46 

v47 : t47 

v48 : t48 

v49 : t49 

v50 : t50 
eg in 

writelnC 50 TYPES COMPILED... 6. 2. 1-8 1 ) 
rid. 



00086300 
00086400 
00086500 
00086600 
00086700 
00086800 
00086900 
00087000 
00087100 
00087200 
00087300 
00087400 
00087500 
00087600 
00087700 
00087800 
00087900 
00088000 
00088100 
00088200 
00088300 
00088400 
00088500 
00088600 
00088700 
00088800 
00088900 
00089000 
00089100 
00089200 
00089300 
00089400 
00089500 
00089600 
00089700 
00089800 
00089900 
00090000 
00090100 
00090200 
00090300 
00090400 
00090500 
00090600 
00090700 
00090800 
00090900 
00091000 
00091100 
00091200 
00091300 



{TEST 6.2.1-9, CEASS=QUALITY} 

{ This test checks that a large number of labels may be declared 
in a program. It is an attempt to detect a small compiler limit on 
the number of labels. } 

program t6p2pld9 (output) ; 
label 

1,2,3,4,5,6,7,8,9,10, 

11,12,13,14,15,16,17,18,19,20, 

21,22,23,24,25,26,27,28,29,30, 

31,32,33,34,35,36,37,38,39,40, 

41,42,43,44,45,46,47,48,49,50; 
begin 

1: 

2: 

3: 

4: 

5: 

6: 

7: 

8: 

9: 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 

22 

23 

24 

25 

26 

27 

28: 

29; 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 



00091400 
00091500 
00091600 
00091700 
00091800 
00091900 
00092000 
00092100 
00092200 
00092300 
00092400 
00092500 
00092600 
00092700 
00092800 
00092900 
00093000 
00093100 
00093200 
00093300 
00093400 
00093500 
00093600 
00093700 
00093800 
00093900 
00094000 
00094100 
00094200 
00094300 
00094400 
00094500 
00094600 
00094700 
00094800 
00094900 
00095000 
00095100 
00095200 
00095300 
00095400 
00095500 
00095600 
00095700 
00095800 
00095900 
00096000 
00096100 
00096200 
00096300 
00096400 
00095500 
00096600 
00096700 
00096800 
00096900 
00097000 
00097100 
00097200 
00097300 
00097400 
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48: 
49: 
50: 

writelnC 50 LABELS DECLARED AND SITED.. .6. 2.1-9* ) 
end. 



{TEST 6.2.2-1, CLASS=CONFORMANCE} 

{ The Pascal Standard permits redefinition of a user name, by a 
further defining occurrence in a range (eg. procedure block) 
enclosed by the first defining occurence. This second range 
(and all ranges enclosed by it) are excluded from the scope of 
the defining occurence of the first range. 
This program tests the scope conformance of the compiler 
for user names. } 

program t6p2p2dl (output) ; 
const 

range = 10; 
var 

i : integer; 

pass : boolean; 
procedure redefine; 
const 

range = -10; 
var 

i : integer; 
begin 

i:=range; 
end; 

begin 
i:=l; 

pass:=false; 
redefine; 
if range=-10 then 

writelnC FAIL... 6. 2. 2-1: SCOPE ERROR-RANGE 1 ) 
else 

pass := true; 
if i=-10 then 

writelnC FAIL. . .6.2.2-1: SCOPE ERROR-I') 
else 

if pass then 

writelnC PASS. ..6.2.2-1') 
end. 
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00099600 
00099700 
00099800 
00099900 
00100000 
00100100 
00100200 
00100300 
00100400 
00100500 
00100600 
00100700 
00100800 
00100900 
00101000 
00101100 
00101200 
00101300 
00101400 
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{TEST 6.2.2-2, CLASS=CONFORMANCE} 

{ The Pascal Standard allows a user to redefine a predefined name. 
This program tests whether this is allowed by this compiler. } 

program t6p2p2d2 (output) ; 
var 

true : boolean; 
begin 

true:=false; 

if true = false then 

writelnC PASS. ..6.2.2-2') 

else 

writelnC FAIL. . .6.2.2-2*) 
end. 



{TEST 6.2.2-3,CLASS=CONFORMANCE} 

{ This program is similar to 6.2.2-4, however a type identifier, 
say T, which specifies the domain of a pointer type TT, is 
permitted to have its defining occurence anywhere in the type 
definition part in which TT occurs. 

Thus in this example, (node=real) s' scope is excluded from the 
type definition of ouch. 

The compiler fails if the program does not compile or fails at 
run time. } 

program t6p2p2d3 (output) ; 
type 

node = real; 
procedure ouch; 
type 

p = Tnode; 

node = boolean; 
var 

ptr : p; 
begin 

new (ptr) ; 

ptrT:=true; 

writelnC PASS. ..6. 2.2-3* ) 
end; 
begin 

ouch; 
end. 
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{TEST 6.2.2-4, CLASS=DEVIANCE} 00106200 

00106300 

{ The Pascal Standard says >i hat the defining occurrence of an 001.06400 

identifier or label precedes all corresponding occurrences of 00106500 

that identifier or label in the program text (except for specific 00106600 

pointercase) . The scope of an identifier or label also includes 00106700 

the whole block in which it is defined, thereby disallowing 00106800 

any references to an outer identifier of the same name preceeding 00106900 

the defining occurrence. Some compilers may not conform 00107000 

to this and allow some scope overlap. 00107100 

The compiler conforms if the program does not compile and objects 00107200 

to the use of 'red* in ouch preceding its definition. } 00107300 

00107400 

program t6p2p2d4 (output) ; 00107500 

const 00107600 

red = 1; 00107700 

violet = 2; 00107800 

procedure ouch; 00107900 

const 00108000 

m = red; 00108100 

n = violet; 00108200 

type 00108300 

a - array[m..n] of integer; 00108400 

var 00108500 

v : a; 00108600 

colour : (yellow, green, blue, red, indigo, violet) ; 00108700 

begin 00108800 

v[l]:=l; 00108900 

colour :=red; 00109000 

end; 00109100 

begin 00109200 

ouch; 00109300 

writeln( f DEVIATES. ..6.2.2-4 — > SCOPE ERROR NOT DETECTED') 00109400 

end. 00109500 



{TEST 6.2.2-5, CLASS=CONFORMANCE} 

{ Similarly to 6.2.2-2, labels are allowed to be redefined 
in a range enclosed by the first defining occurrence 
(eg. procedures and functions) . This program tests if 
this is permitted by this compiler. } 

program t6p2p2d5 (output) ; 
label 

4,5,6; 
var 

i : integer; 
procedure redefine; 
label 

6,7,8; 
var 

j : integer; 
begin 

goto 6; 
7: j:=j-l; 

goto 8; 
6: j:=j+l; 

goto 7; 
8: j:=0; 
end; 

begin 

goto 4; 
5: i:=i+l; 
goto 6; 
4: i:=l; 
redefine; 
goto 5; 
6: if i=l then 

writeln(» FAIL. ..6.2. 2-5 1 ) 
else 

writelnC PASS. . .6.2. 2-5 1 ) 
end. 



<T> 
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00113200 -^i 
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00113400 






GO 



{TEST 6.2.2-6, CLASS=CONFORMANCE} 

{ As for the other conformance tests in this section, 

it is possible to redefine a field-name of a record within 

the same scope as this record. 

The compiler also fails if the program does not compile. } 

program t6p2p2d6 (output) ; 
var 

j : integer; 
x : record 

j: integer 
end; 
begin 

x.j:=2; 
with x do 

j:=3; 
if (j=l) and (x.j=3) then writelnC PASS. ..6.2. 2-6') 
else writelnC FAIL. ..6. 2.2-6* ) 
end. 



{TEST 6.2.2-7, CLASS=DEVIANCE} 

{ It is possible to redefine a function name within the scope 
of a function name. This test checks that the inner function 
redefines f , whether an erroneous assignment to f is detected or 
whether the erroneous outer f, with no function assignment is 
allowed to execute. } 

program t6p2p2d7 (output) ; 
var 

boo 1: boo lean; 

j: integer; 

function f(i:integer) : integer; 
function f(i:integer) : integer; 
begin 

f:=i 
end; 
begin 

if bool then 

writeln(« FAIL.. .6.2.2-7, PROCEDURE SCOPE ' ) 
{ FAILs if the call is recursive } 
else begin 
bool:=true; 
f:=f(i); 
end 
end; 

begin 

bool:=false; 

j:=f(l); 

if (j=l) then 

writeln( 6 DEVIATES. . .6.2.2-7, PROCEDURE SCOPE'); 
end. 
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{TEST 6.2.2-8, CLASS=CONFORMANCE} 

{ It is possible to declare a function but not assign a value 
to that function at that level. This program assigns a value 
to a function from within a function within the function. 
The compiler fails if the program does not compile or it prints 
FAIL. } 

program t6p2p2d8 (output) ; 
var 

j,k: integer; 

function fl (i: integer) : integer; 
function f 2 ( i : integer) : integer; 
function f3 (i: integer) : integer; 
begin 
f3:=l; 
fl:=i 
end; 
begin 

f2:=f3(i) 
end; 
begin 

j:=f2(i) 
end; 

begin 

k:=fl(5); 

if (k=5) then 

writelnC PASS. ..6.2.2-8, FUNCTION*) 
else 

writeln( f FAIL. . .6.2.2-8, FUNCTION') 
end. 
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{TEST 6.2.2-9, CLASS=DEVTANCE} 

{ This program attempts to assign a value to a function outside 
the bounds of the function. The compiler deviates if the 
program prints DEVIATES. } 

program t6p2p2d9 (output) ; 
var 

i: integer; 

function fl: integer; 
begin 

fl:=6 
end; 

function f 2 ( i : integer) : integer; 
begin 

f2:»i; 

fl:=5 
end; 

begin 

i:=fl; 

i:»f2(2); 

writelnC DEVIATES. ..6.2.2-9, FUNCTION') 
end. 
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{TEST 6.2.2-10, CLASS=CONFORMANCE} 

{ This obscure program is nevertheless standard Pascal. 
An inner scope hides part of a type while leaving other parts 
accessible. The compiler fails if the program does not 
compile or the program prints FAIL. } 

program t6p2p2dl0 (output) ; 
type 

colour= (red, amber , green) ; 
var 

crcolour; 

procedure nested; 
type 

colour= (pur pie, red, blue) ; 
var 

paint: colour; 
begin 

c:=green; 

paint:=red; 

c:=pred( amber) ; 

if (ord(c)OO) or (ord (paint) <>1) then 
writelnC FAIL. ..6.2.2-10, SCOPE'); 
end; 

begin 

nested; 

if (c<> red) then 

writelnC FAIL. ..6.2.2-10, SCOPE') 
else 

writelnC PASS. ..6.2.2-10, SCOPE') 
end. 
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{TEST 6.3-1, CLASS=C0NF0RMANCE} 

{ This program exhibits all legal productions for a constant 
in a const declaration. } 

program t6p3dl (output) ; 
const 

ten = 10; 

minusten = -10; 

minustentoo = -ten; 

decade = ten; 

dot = » . ' ; 

stars = •****'; 

on = true; 

pi = 3.1415926; 

minuspi = - pi; 
begin 

writelnC PASS. . .6.3-1') 
end. 
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{TEST 6.3-2, CLASS=DEVIANCE} 

{ This program checks that signed chars are not permitted. 
Note that minus may have a worse effect than plus. } 

program t6p3d2 (output) ; 
const 

dot = '.'; 

plusdot = + dot; 
begin 

writelnC DEVIATES. . .6.3-2') 
end. 



{TEST 6.3-3, CLASS=DEVIANCE} 

{ This program checks that signed strings are not permitted. 
Note that minus may have a worse effect than plus. } 

program t6p3d3 (output) ; 
const 

stars = •****». 

plusstars = + stars; 
begin 

writelnC DEVIATES. ..6.3-3') 
end. 



{TEST 6.3-4, CLASS=DEVIANCE} 

{ This program checks that signed scalars are not permitted. 
Note than minus may have a worse effect than plus. } 

program t6p3d4 (output) ; 
const 

truth = true; 

plustruth = + truth; 
begin 

writelnC DEVIATES. . .6.3-4*) 
end. 



{TEST 6.3-5, CLASS=DEVIANCE} 

{ This program tests that signed constants are not permitted 
in other contexts than const declarations. } 

program t6p3d5 (output) ; 
const 

dot = '.'; 
begin 

writelnC DEVIATES 1 , +dot, '..6.3-5') 
end. 
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{TEST 5.3-6, CLASS=DEVIANCE} 

{ A constant may not be used in its own declaration - the 
following is a pathological case which should be detected 
or at least handled with care. } 

program t6p3d6 (output) ; 
const 

ten = 10; 

procedure p; 
const 

ten = ten; 
begin 

if ten=10 then 

writelnC DEVIATES. ..6.3-6: SCOPE ERROR 1 ) 
else 

writelnC DEVIATES. ..6.3-6: DEFINITION POINT ERROR 1 ) 
end; 

begin 

P 
end. 



{TEST 6.4.1-1, CLASS=CONFCRMANCE} 

{This program tests to see that pointer types can be 
declared anywhere in the type part. This freedom 
is explicitly permitted in the standard. } 

program t6p4pldl (output) ; 
type 

ptrl = T polar; 

polar = record r,theta : real end; 

purelink = T purelink; 

ptr2 = f person; 

ptr3 = ptr2; 

person = record 

mother, father : ptr2; 
firstchild : ptr2; 
nextsibling : ptr3 
end; 
begin 

writelnC PASS. ..6. 4. 1-1* ) 
end. 
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{TEST 6.4.1-2, CLASS=DEVIANCE} 

{ This program tests that attempts to use types in their 
own definitions are detected. Two examples are 
attempted. Both should fail. } 

program t6p4pld2 (output) ; 
type 

x = record 

xx : x 
end; 
y = array [0..1] of y; 
begin 

writelnC DEVIATES. ..6.4.1-2') 
end. 



{TEST 6.4.1-3, CIASS=DEVIANCE} 

{ This program also tests that attempts to use types in 
their own definitions are detected, but inserts a nasty 
scope twist by making another type with the same identifier 
available in an outer scope. It should be excluded from this 
scope, according to the Standard. } 

program t6p4pld3 (output) ; 
type 

x = integer; 

procedure p; 
type 

x = record 

y : x 
end; 
begin 

writelnC DEVIATES. ..6.4.1-3: SCOPE ERROR') 
end; 

begin 

P 
end. 
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{TEST 6.4.2.2-1, CLASS=CONFQRMANCE} 

{ This program tests that the standard simple types have all 

been implemented. They are denoted by predefined type identifiers. 
The compiler fails if the program does not compile. } 

program t6p4p2p2dl (output) ; 
var 

a : integer; 

b : real; 

c : boolean; 

d : char; 
begin 

a:=6*2+3; 

b:=3. 14159*2; 

c:=(a=15); 

d:=*Z'; 

writelnC PASS. . .6.4.2.2-1') 
end. 



{TEST 6.4.2.2-2, CIASS=CONFORMANCE} 

{ The Pascal Standard specifies that the values an integer may 
take are within the range -maxint..+maxint. 
This program checks this. } 

program t6p4p2p2d2 (output) ; 
type 

natural = 0..maxint; 

whole = -maxint..+maxint; 
var 

i : natural; 

j : whole; 

k : integer; 
beg in, 

i:=maxint; 

j:=-maxint; 

k:=maxint; 

writelnC PASS.. .6.4.2.2-2') 
end. 
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{TEST 6.4.2.2-3, CLASS=CONFORMANCE} 

{ The Pascal Standard states that type BOOLEAN has truth values 
denoted by the identifiers true and false, and that they are 
such that false is less than true. 
This program tests if the compiler allows this. } 

program t6p4p2p2d3 (output) ; 
begin 

if false < true then 

writelnC PASS. . .6.4.2.2-3') 
else 

writelnC FAIL. . .6.4.2.2-3') 
end. 



00147000 
00147100 
00147200 
00147300 
00147400 
00147500 
00147600 
00147700 
00147800 
00147900 
00148000 
00148100 
00148200 
00148300 



> 
CD 



4^» 
O 



{TEST 6.4.2.2-4, CLASS=CONFORMANCE} 

{ The Pascal Standard states that the character values representing 
the digits 0..9 are ordered and contiguous. 
The program tests these two criteria for these characters. } 

program t6p4p2p2d4 (output) ; 
var 

a,b : boolean; 
begin 

a:=(succ(*0') = '1') and 

(succ('l') = '2') and 

(succ('2') = '3') and 

(succ( , 3 l ) = '4') and 

(succ(»4») = '5') and 

(succC5') = '6') and 

(succ('6') = »7') and 

(succC?*) =* '8') and 

(succ('8') = '9') ; 
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1 


('8' 


< 


'9') 


; 



if a and b then 

writelnC PASS. ..6.4.2.2-4') 
else 

writelnC FAIL. . .6.4.2.2-4') 



end. 



{TEST 6.4.2.2-5, CLASS=CONFORMANCE} 

{ The Pascal Standard states that the upper-case letters A-Z are 
ordered, but not necessarily contiguous. 
This program determines if this is so, and prints 
a message as to whether the compiler passes or not . } 



program t6p4p2p2d5 (output) ; 
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writelnC PASS... 6. 4 
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writelnC FAIL... 6. 4 
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') 





end. 
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{TEST 6.4.2.2-6, CLASS=CCNF0RMA1NICE} 

{ The Pascal Standard states that the lower-case letters a-z are 
ordered, but not necessarily contiguous. 
This program determines if this is so, and prints 
a message as to whether the compiler passes or not . 
NOTE: this program uses lower-case char constants and may 
fail for this reason. The test is also irrelevant for 
one-case compilers. } 



program t6p4p2p2d6 (output) ; 

begin 

'b») and ('b' < 
•e') and (*e' < 
•h') and ('h' < 
•k') and ('k' < 
'n') and ('n' < 
'q') and Cq' < 
't') and ('f < 
»w') and ('W < 
'z') then 
writelnC PASS. . .6.4.2, 
else 

writelnC FAIL. . .6.4.2, 

end. 
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{TEST 6.4.2.2-7, CLASS=IMPLEMENTATIONDEFINED} 

{ The Pascal Standard states that the value of maxint is 
dependent on the implementation. 

This program prints out the implementation defined value 
of maxint. } 

program t6p4p2p2d7 (output) ; 
begin 

writelnC THE IMPLEMENTATION DEFINED VALUE OF MAXINT IS 
maxint) 
end. 



{TEST 6.4.2.3-1, CLASS=€ONFORMANCE} 

{ This program checks the possible syntax productions for 
enumerated types, as specified by the Pascal Standard. 
The compiler fails if the program does not compile. } 

program t6p4p2p3dl (output) ; 
type 

singular itytype 

switch 

marital status 

colour 

cardsuit 
var 

i : singularitytype; 
begin 

i:=me; 

writelnC PASS. . .6.4.2.3-1') 
end. 



(me) ; 

(on,off) ; 

(married, divorced, widowed, single) ; 

(red, pink, orange, yellow, green) ; 

(heart, diamond, spade, club) ; 
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{TEST 6.4.2.3-2, CLASS=CONFORMANCE} 

{ The Pascal Standard states that the ordering of the values 
of the enumerated type is determined by the sequence in which 
the constants are listed, the first being before the last. 
The compiler fails if the program does not compile. } 

program t6p4p2p3d2 (output) ; 
var 

suit : (club, spade, diamond, heart); 
a : boolean; 
b : boolean; 
begin 

a:=(succ(club)=spade) and 
(succ (spade) ^diamond) and 
(succ (diamond) =heart) ; 

b:=(club < spade) and 
(spade < diamond) and 
(diamond < heart) ; 

if a and b then 

writelnC PASS. ..6.4.2.3-2') 
else 

writelnC FAIL... 6. 4. 2. 3-2') 
end. 



{TEST 6.4.2.4-1, CLASS=CONFORMANCE} 

{ This program tests that a type may be defined as a subrange 
of another ordinal- type (host- type) . 
The compiler fails if one or more of the cases below are rejected. } 

program t6p4p2p4dl (output) ; 
type 

colour = (red,pink,orange,yellow,green,blue); 

somecolour = red.. green; 

century = 1..100; 

twentyone = -10.. +10; 

digits = *0'..'9»; 

zero = 0. .0; 

logical = false.. true; 
var 

tf : logical; 

begin 

tf:=true; 

writelnC PASS... 6. 4. 2. 4-1') 
end. 
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{TEST 6.4.2.4-2, CLASS=DEVTANCE} 

{ This program tests to see if real constants are permitted 
in a subrange declaration. The Pascal Standard states that 
a subrange definition must be of a subrange of another ordinal 
type. This rules out real constants in the definition. } 

program t6p4p2p4d2 (output) ; 
type 

wiregauge = 0.001.. 0.2; 
begin 

writelnC DEVIATES.. .6.4.2.4-2') 
end. 



{TEST 6.4.2.4-3, CLASS=DEVTANCE} 

{ The Pascal Standard states that the first constant in a definition 
specifies the lower bound, which is less than or equal to the 
upper bound. 

This program tests the compilers 1 conformance to this point. 
The compiler conforms if both the cases are rejected. } 

program t6p4p2p4d3 (output) ; 
type 

mixedup = 100.. 0; 

reverse = 'Z* ..'A'; 
begin 

writelnC DEVIATES. . .6.4.2.4-3 : EMPTY SUBRANGES ALLOWED') 
end. 



{TEST 6.4.3.1-1, CLASS=DEVTANCE} 

{ The Pascal Standard states that only structured types may be 
PACKED (array, set, file and record types) . 
This program tests this point. The compiler conforms if 
the program will not compile. } 

program t6p4p3pldl (output) ; 
type 

switch = packed(on,off); 

state = packed (high, low, invalid); 

decade = packed 0..10; 
begin 

writelnC DEVIATES... 6. 4. 3. 1-1 : IMPROPER USE OF PACKED') 
end. 
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{TEST 6.4.3.1-2, CLASS=DEVIANCE} 00168700 

00168800 

{ The Pascal Standard states that a structured type identifier 00168900 

may not be used in a PACKED type definition. 00169000 

The compiler passes if the program fails to compile. } 00169100 

00169200 

program t6p4p3pld2 (output) ; 00169300 

type 00169400 

complex = record 00169500 

realpart : real; 00169600 

imagpart : real; 00169700 

end; 00169800 

packcom = packed complex; 00169900 

begin 00170000 

writelnC DEVIATES. ..6.4.3.1-2 : IMPROPER USE OF PACKED 1 ) 00170100 

end. 00170200 



{TEST 6.4.3.1-3, CLASS=C0NFORMANCE} 

{ The Pascal Standard allows array, set, file and 
record types to be declared as PACKED. 
The program simply tests that all these are 
permitted. 
The compiler fails if the program will not compile. } 



program t6p4p3pld3 (output) ; 


type 




urray 


= packed array[1..10] of char; 


rekord 


= packed record 




bookcode : integer; 




authorcode : integer; 




end; 


fyle 


= packed file of urray; 


card 


= (heart , diamond, spade, club) ; 


sett 


= packed set of card; 


begin 




writeln( 


' PASS... 6. 4. 3. 1-3') 


end. 
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{TEST 6.4.3.2-1, CLASS==C0NF0RMANCE} 00172400 

00172500 

{ This program tests all the valid productions for an 00172600 

array declaration from the syntax specified by the 00172700 

Pascal Standard. 00172800 

The compiler fails if one or more cases are rejected. } 00172900 

00173000 

program t6p4p3p2dl (output) ; 00173100 

type 00173200 

cards = (two, three, four, five, six, seven, eight, nine, ten, jack, 00173300 

queen, king, ace); 00173400 

suit = (heart,diamond,spade,club); 00173500 

hand = array[cards] of suit; 00173600 

picturecards= array[ jack.. king] of suit; 00173700 

played = array[cards] of array [heart.. diamond] of boolean; 00173800 

playedtoo = array[cards,heart.. diamond] of boolean; 00173900 

begin 00174000 

writelnC PASS. . .6.4.3.2-1') 00174100 

end. 00174200 



{TEST 6.4.3.2-2, CLASS=DEVIANCE} 

{ The Pascal Standard states that an index-type must be an 
ordinal-type. This does not include REAL. 
This program tests if the compiler will allow real bounds. } 

program t6p4p3p2d2 (output) ; 
type 

reel test = array[ 1.5.. 10.1] of real; 
begin 

writelnC DEVIATES. . .6.4.3.2-2') 
end. 
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{TEST 6.4.3.2-3, CLASS=CONFORMANCE} 

{ An index type may be an ordinal type, This allows 
the use of BOOLEAN, INTEGER and some userdefined type 
names to be used as an index type. 
This program tests if the compiler will permit these 
except for INTEGER, which is included in a separate program* 

program t6p4p3p2d3 (output) ; 
type 



digits 

colour : 

intensity 
var 

all too 

numeric 

colours 

code 
begin 

numeric ['0'] :=0; 

colours [pink] :=bright; 

alltoo[true] :=false; 

code['A']:='0'; 

writelnC PASS. ..6.4.3.2-3 
end. 



'O'..^*; 

(red,pink,orange,yellow) ; 
= (bright, dull); 

array [boolean] of boolean; 
arrayfdigits] of integer; 
arrayfcolour] of intensity; 
array [char] of digits; 
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{TEST 6.4.3.2-4, CLASS=QUALITY} 

{ As mentioned in 6.4.3.2-3, an index type is an ordinal type, 
thus INTEGER may appear as an index type. However on most 
machines this would represent an unusually large array, and 
thus may not be allowed by the compiler. 

This program tests if such a declaration is permitted, and if 
not, is the diagnostic appropriate. } 

program t6p4p3p2d4 (output) ; 
type 

everything = array[ integer] of integer; 
var 

all : everything? 
begin 

all[maxint] :=1; 

all[0]:=l; 

all[-maxint] :=1; 

writelnC QUALITY. . .6.4.3.2-4: 
end. 



~>INTEGER BOUNDS PERMITTED 1 ) 



{TEST 6.4.3.2-5, CLASS-DEVIANCE} 

{ Strings must have a subrange of integers as an index type. 
The compiler deviates if this program compiles and 
prints DEVIATES. } 

program t6p4p3p2d5 (output) ; 
type 

colour = (red,blue,yellow,green) ; 

ell = blue.. green; 
var 

srpacked array[cll] of char; 
begin 

s^'ABC; 

writelnC DEVIATES. . .6.4.3.2-5, INDEX TYPE*) 
end. 
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{TEST 6.4.3.3-1, CLASS=CONFORMANCE} 00181600 

00181700 

{ This program simply tests that all valid productions from 00181800 

the syntax for record types (as specified by the Pascal Standard) 00181900 

are accepted by this compiler. 00182000 

The compiler fails if one or more cases are rejected. } 00182100 

00182200 

program t6p4p3p3dl (output) ; 00182300 

type 00182400 

string = packed array[1..25] of char; 00182500 

married = (false, true) f « 00182600 

shape = (triangle, rectangle, square, circle) ? 00182700 

angle - 0..90; 00182800 

a = record 00182900 

year : integer? 00183000 

month : 1..12; 00183100 

day : 1..31 00183200 

end; 00183300 

b = record 00183400 

name,firstname : string; 00183500 

age : 0..99? 00183600 

case married of 00133700 

true: (spousename : string); 00183800 

false : () 00183900 

end; 00184000 

c = record 00184100 

case s : shape of 00184200 

triangle : (side : real; 00184300 

inclination, anglel,angle2 : angle); 00184400 

square, rectangle : (sidel,side2 ; real; 00184500 

skew,angle3 t angle) ; 00184600 

circle : (diameter : real) 00184700 

end; 00184800 

d = record ; end; 00184900 

e = record 00185000 

case married of 00185100 

true : (spousename : string); 00185200 

false : (); 00185300 

end; 00185400 

begin 00185500 

writelnC PASS. ..6.4.3.3-1') 00185600 

end. 00185700 
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{TEST 6.4.3.3-2, CIASS=CONFORMANCE} 

{ The Pascal Standard states that the occurrence of a field 
identifier within the identifier list of a record section is 
its defining occurence as a field identifier for the record 
type in which the record section occurs. 

This should .allow redefinition of a field identifier in another 
type declaration. 
The compiler fails if the program does not compile. } 

program t6p4p3p3d2 (output) ; 
type 

a = record 

realpart : real; 
iraagpart : real 
end; 
realpart - (rx>timaginary,withbody,withsubstance) ; 
begin 

writelnC PASS... 6. 4. 3. 3-2') 
end. 



{TEST 6.4.3.3-3, CLASS=CONFCRMANCE} 

{ The Pascal Standard permits the declaration of an empty record, 
this empty record serves little purpose, and for this reason 
some compilers will not allow it to be used. 
The compiler fails if the program does not compile. } 

program t6p4p3p3d3 (output) ; 
type 

statuskind = (defined, undefined) ; 
emptykind » record end; 
var 

empty : emptykind; 
number: record 

case status :statuskind of 
defined : (i : integer); 
undefined: (e : emptykind) 
end; 
begin 

with number do 
begin 

status : «def ined; 
i:=7 
end; 

writeln(» PASS. ..6.4.3.3-3') 
end. 
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{TEST 6.4.3.3-4, CLASS=CONFORMANCE} 

{ Similarly to 6.4.3.3-2, a tag-field may be redefined 
elsewhere in the declaration part. 
The compiler fails if the program will not compile. } 

program t6p4p3p3d4 (output) ; 
type 

which = (white, black, warlock, sand) ; 
var 

polex : record 

case which: boolean of 
true: (realpart: real? 
imagpartrreal) ; 
f al se : ( theta ; real ; 
magnit?real) 
end; 
begin 

polex. which :=true; 
polex . realpart : =0 . 5; 
polex . imag part :=0. 8; 
writelnC PASS. . .6.4.3.3-4') 
end. 



{TEST 6.4.3.3-5, CLASS=ERRORHANDLING } 

{ The Pascal Standard states that if a change of variant occurs 
(by assigning a value associated with a variant to the 
tag-field) , then the fields associated with the previous variants 
cease to exist. This program causes the error to occur. } 

program t6p4p3p3d5 (output) ; 
type 

two = (a,b) ; 
var 

variant : record 

case tag field: two of 
a: (m: integer); 
b: (n: integer); 
end; 
i : integer; 
begin 

variant. tag field :=a; 
variant .m:=l; 

i:=variant.n; {illegal} 
writelnC ERROR NOT DETECTED. . .6.4.3.3-5') 
end. 
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{TEST 6.4.3.3-6, CLASS=ERRORHANDLING } 

{ The program causes an error by accessing a field with 
an undefined value. The undefinition arises because 
when a change of variant occurs, those fields associated with 
the new variant come into existence with undefined 
values. } 



program t6p4p3p3d6 (output) 




type 








two 


= (a,b); 






var 








variant : record 








case 


tag field: two of 




a 


: (m : 


integer; 






1 : 


integer) ; 




b 


: (n : 


integer; 






o : 


integer) 




end; 






i : 


integer; 







begin 

variant. tagfield:=a; 

variant.m:=l; 

variant.l:=l; 

variant.tagfield:=b; 

variant .n:=l; 

i:=variant.o; { illegal } 

writelnC ERROR NOT DETECTED.. .6.4.3. 3-6») 
end. 



{TEST 6.4.3.3-7, CLASS=ERRORHANDLING } 

{ This test is similar to 6.4.3.3-5, except that no tagfield is 
used. 

Variant changes occur implicitly as a result of 
assignment to fields. The fields associated with the new 
variant come into existence with undefined values. } 

program t6p4p3p3d7 (output) ; 
type 

two - (a,b); 
var 

variant : record 

case two of 

a : (m : integer) ; 
b : (n : integer) ; 
end; 
i : integer; 
begin 

variant.m:=2; 

invariant. n; { illegal } 
writelnC ERROR NOT DETECTED. . .6.4.3.3-7') 
end. 
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{TEST 6.4.3.3-8, CLASS=ERRORHANDLING } 

{ Similar to 6.4.3.3-5, except that no tag-field is used. 
A change of variant occurs by reference to a field associated 
with a new variant. Again, these fields come into existance 
undefined. 
The compiler conforms if the program does not compile. } 

program t6p4p3p3d8 (output) ; 
type 

two = (a,b); 
var 

variant : record 

case two of 

a: (m: integer 

1: integer) ; 
b: (n: integer; 
o:integer) 
end; 
i : integer; 
begin 

variant ,n:=l 
variant .o:=l 
variant ,m:=l 
i:=variant.l 



{illegal} 
writelnC ERROR NOT DETECTED. 
end. 
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[TEST 6.4.3.3-9 f CLASS=QUALITY} 

( Note this program relies on the compiler deviating for tests 
6.4.3.3-5 to 6.4.3.3-8. 

If the compiler conforms for these tests, this program will 
not compile/run. 

The method of storage for fields of variants may differ, 
depending on the method of definition. 

Programmers should not rely on the VALUES of fields under 
one variant still being accessible from another. However, the 
relationships between the two variants in this example may be 
determined by the output of the program. } 

program t6p4p3p3d9 (output) ; 
type 

two = (a,b); 
var 

variant : record 

case tag field : two of 
a: (i,j,k : integer); 
b: (1 : integer; 
m : integer; 
n : integer) 
end; 
begin 

variant .tag f ield :=a; 

variant.i:=l; 

variant.j:=2; 

variant.k:=3; 

variant. tag f ield :=b; 

if (variant. 1=1) and (variant.m=2) then 

writelnC EXACT CORRELATION— I:L J:M K:N') 
else 
if (variant. 1=3) and (variant.m=2) then 

writelnC REVERSE CORRELATION — I:N J:M K:L') 
else 

writelnC UNKNOWN CORRELATION - lmn are:', 
variant. 1 ,variant.m,variant.n) 
end. 
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{TEST 6.4.3.3-10, CLASS=CONFORMANCE} 

{ The Pascal Standard states that case constants must be distinct, 
and are of an ordinal type which is compatible with the 
tag-field. 

This program tests to see if the compiler will permit case 
constants outside the tag-field subrange - it should . 
The compiler passes if the program runs. 

A warning might be appropriate, however, as fields outside the 
tag field subrange are not accessible. } 

program t6p4p3p3dl0 (output) ; 
type 

a = 0..3; 
b = record 

case c:a of 

0: (d:array[l c 

1: 

2: 

3: 

4: 



end; 



(e:array[l t 
(f:array[1..4} 
(g:array[U.5] 
(hrarrayfl. .6) 



of boolean) , 
of boolean^ , 
of boolean) , 
of boolean) ; 
of boolean) 



begin 

writelnC PASS. . .6. 4. 3. 3-10 f ) 
end. 



{TEST 6.4.3.3-11, CLASS=DEVIANCE; 

{ This program is similar to 6.4. 3. 3-3 f except, here, v-r..*-. 
empty record is assigned a value. Tm£ should noti'o^ u>ssa 
The program conforms if the program does not compLIs or rut- 
prog ram t6p4p3p3dll (output) ; 
type 

statuskind = (defined, undefined) ; 
emptykind = record end; 
var 

empty : emptykind; 
number: record 

case status :statuskind of 



defined : (i : 


integer) ; 


undefined: (e : 
end* 


emptykind) 


begin 




with number do 




begin 




status :=undefined; 




e:=666 




end; 




writelnC PASS. . .6.4.3.3-11 


•} 


end. 
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{TEST 6.4.3.3-12, CLASS=ERRORHANDLING } 

{ This program is similar to 6.4.3.3-3, except here 
an error is caused by assigning the undefined value 
of the variable empty to the field e. 
This error should be detected. } 

program t6p4p3p3dl 2 (output) ; 
type 

statuskind = (defined ,undefined) ; 
emptykind = record end; 
var 

empty : emptykind; 
number: record 

case status: statuskind of 
defined : (i : integer); 
undefined: (e : emptykind) 
end; 
begin 

with number do 
begin 

status :=undef ined; 

e:=empty { undefined despite being empty } 

end; 

writelnC PASS... 6. 4. 3. 3-12') 
end. 



{TEST 6.4.3.3-13, CIASS=CCNFCRMANCE} 

{ Ttiis test checks that nested variants are allowed 
with the appropriate syntax. The compiler fails if the 
program does not compile and print PASS. } 

program t6p4p3p3dl 3 (output); 
type 

a- record 

case b: boo lean of 
true: (c:char); 
false: (case d: boo lean of 
true: (e:char); 
false: (f:integer)) 
end; 
var 

g:a; 
begin 

g.b:=false; 
g.d:-false; 

g.f:»i; 

writelnC PASS... 6. 4. 3. 3-13, VARIANTS 1 ) 
end. 
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{TEST 6.4.3.4-1, CLASS=C0NF0RMANCE} 

{ This program simply tests that set types as described in the 
Pascal Standard are permitted. 
Ttie compiler fails if the program will not compile. } 

" program t6p4p3p4dl (output) ; 
type 

colour = (red, blue, pink, green, yellow); 

setone = set of colour; 

settwo = set of blue.. green; 

setthree = set of boolean; 

setfour = set of 1..10; 

setfive = set of 0..3; 

setsix = set of (heart, d iamond, spade,club) ; 
begin 

writelnC PASS. ..6. 4. 3. 4-1') 
end. 



{TEST 6.4.3.4-2, CLASS=IMPLEMENTATIONDEFINED} 

{ This program tests if a set of char is permitted by the 
compiler. } 

program t6p4p3p4d2 (output) ; 
var 

s : set of char; 
begin 

s:«[Vr' V9Vz']; 

if (f 1 * 1 ' ' '9 1 ' z'l <= s) then 

writelnC IMPLEMENTATION ALLOWS SET OF CHARM 
else 

writelnC IMPLEMENTATION DOES NOT ALLOW SET OF CHAR') 
end. 



{TEST 6.4.3.4-3, CLASS=DEVTANCE} 

{ The Pascal Standard states that the base-type of the range 
of a set must be an ordinal- type. This should eliminate sets with 
real and structured ranges. Some compilers may allow these and 
hence will deviate for those cases not flagged as errors. } 

program t6p4p3p4d3 (output) ; 

type 

legalset = set of 1..3; 

urray = array[1..4] of integer; 

setone = set of real; { case 1 ] 

settwo = set of record a : 0. .3 end; { case 2 } 

setthree = set of array[1..5] of real; { case 3 } 

setfour = set of urrayj { case 4 } 

setfive = set of legalset; { case 5 } 

setsix = set of set of 1..4; { case 6 } 

begin 

writelnC DEVIATES. ..6.4.3.4-3*) 

end. 
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{TEST 6.4.3.4-4, CLASS=IMPLEMENTATIONDEFINED} 00222000 

00222100 

{ The Pascal Standard states that the largest and smallest values 00222200 

permitted in the base-type of a set-type are implementation 00222300 

defined. 00222400 

The size of the base- type permitted may be determined by 00222500 
examining which of the cases below are accepted by the compiler. } 00222600 

00222700 

program t6p4p3p4d4 (output); 00222800 

type 00222900 

setone = set of -1..+1; 00223000 

settwo = set of char; 00223100 

setthree = set of 0..1000; 00223200 

setfour = set of 0..10; 00223300 

setfive = set of 0..20; 00223400 

setsix = set of 0..30; 00223500 

setseven = set of 0..40; 00223600 

seteight = set of 0..50; 00223700 

setnine = set of 0..60; 00223800 

setten = set of 0..70; 00223900 

var 00224000 

s : setthree; 00224100 

begin 00224200 

s:=[1000]; 00224300 

writelnC IMPLEMENTATIONDEFINED. . .6.4.3.4-4 — >' , 00224400 

'GOOD IMPLEMENTATION OF SETS') 00224500 

end. 00224600 



{TEST 6.4.3.4-5, CLASS=QUALITY } 

{ This test is an implementation of Marshall's algorithm 

in Pascal. It serves to give a program which can be used both 
to time a simple procedure using sets, and which can measure 
the space requirements. In both cases the measurements of the 
procedure Marshall are to be compared. 

By way of comparison, the Tasmanian compiler on the Burroughs 
B6700 yielded 

space = 143 bytes ( 6864 bits) 
time = 0.816461 seconds 
} 
program t6p4p3p4d5 (output) ? 
const 

size = 79; {array is (size+1) by (size-fl) square) 
words = 4; {size div 1£; 

bitsperword = 16; (ass^m* everyone allows thi^] 
bitsminusl = 15; {bi ; .:i^,iW?rd-l ] 
type 

btype = array [0..sizei of: array [0.. words] 
of set of 0. .bitsminusl; 
var 

seed: integer; 

tl,t2:real; 

original ,closure:btype; 

function generate: integer; 
begin 

seed :=57*seed+l; 

generate := (seed mod ^-iixri-l) ) , s 

seed:=seed mod 571 
end; {of generate} 

procedure fill(var a:btype; pfinteger)^ 
var 

i:0. .size; 
j:0.. bitsminusl; 
k,l:0. .maxint; 
begin 

for j:=0 to words do a[0][j]: = []j 
for i:=l to size do a[i]:=a[0]; 
for k:=l to p do begin 
i:=generate; 
l:=generate; 
j:=l div bitsperword; 

a[i][j] := a[i][j]-K(i mod bitsperword)] 
end 
end; {of fill} 

procedure print(var b : btype) t 
var 

i ,j:0..size; 
begin 

for i:=0 to size do begin 
writeC '); 
for j:=0 to size do begin 

if (j mod bitsperword) in b[i][j div bitsperword] then 

write( , +») 
else 

write( , - f ) 
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end; 
writeln 
end 
end; {of print} 

procedure warshallsalgorithm(var a,b:btype); 

{examine the code to see how many bytes of 8-bits are required} 
var 

i,j:0..size; 
k:0. .words; 
begin 
b:=a; 

for i:=0 to size do 
for j:=0 to size do 

if (i mod bitsperword) in b[j] [i div bitspera>rd] then 
for k:=0 to words do 

b[j][k] := b[j][k]+b[ij[k); 
end; {of warshallsalgorithm} 

begin {of main program} 

seed:=l; 

fill (original, 125); 

tl:=processtime; {ie begin timing however" you do it} 

warshallsalgorithm (original , closure) ; 

t2:=processtime; {ie stop timing} 

writeln( • TIME^ ,t2-tl) ; 

writeln ( • ORIGINAL MATRIX* ) ; 

print (original) ; 

writelnC TRANSITIVE CLOSURE'); 

print (closure) 
end. 



{TEST 6.4.3.5-1, CLASS=CONFORMANCE} 

{ A file-type is a structured type consisting of a sequence of 
components which are all one type. All cases in this program 
should pass. 
The compiler fails if one or more cases are rejected. } 



program t6p4p3p5dl I 


(output) ; 




type 








i = integer; 






var 








ptrtoi: 


Ti; 






filel : 


file of 


char; 




file2 : 


file of 


real; 




file3 : 


file of 
record 








a : 


integer; 






b : 


boolean 






end; 






file4 : 


file of set of (red, blue, green 


,purple) ; 


file5 : 


file of 


ptrtoi; 




begin 








writeln 


l(' PASS., 


..6.4.3.5-1') 




end. 









00230800 
00230900 
00231000 
00231100 
00231200 
00231300 
00231400 
00231500 
00231600 
00231700 
00231800 
00231900 
00232000 
00232100 
00232200 
00232300 
00232400 
00232500 
00232600 
00232700 
00232800 
00232900 
00233000 
00233100 
00233200 
00233300 
00233400 
00233500 
00233600 
00233700 
00233800 



00233900 
00234000 
00234100 
00234200 
00234300 
00234400 
00234500 
00234600 
00234700 
00234800 
00234900 
00235000 
00235100 
00235200 
00235300 
00235400 
00235500 
00235600 
00235700 
00235800 
00235900 
00236000 
00236100 
00236200 



{TEST 6.4.3.5-2, CLASS=€ONFORMANCE} 

{ The Pascal Standard provides for a predefined filetype, type 
TEXT. Variables of type TEXT are called TEXT FILES. This program 
tests that such a type is permitted and that the type adheres 
to the structure laid down in the Standard. The compiler fails 
if the program will not compile and run. } 

program t6p4p3p5d2 (output) j? 
var 

filel : text; 

chare : char; 
procedure ahaa; 
begin 

writelnC FAIL. ..6.4.3,5-2') 
en&i 



begin 

rewrite( filel); 

writeln(filel); 

writeln( filel,' ABC').? 

reset (filel); 

if eoln(filel) then get(filel) 

else ahaa; 



{ no character'; 
( characters &r 



bat z. linemarker) 

1 if marker} 



then get (filel) 
then get (filel) 
then get (filel) 



) then get( filel) 



if fileir= , A l 

else ahaa ? - 

if filelt='B' 

else ahaa; 

if filelt^C 1 

else ahaa; 

if eoln(filel) and (filel 

else ahaa; 

if eof(filel) then 

writelnC PASS. . .6. 4* 3.5-2 f ) 
else ahaa 
end. 



{TEST 6.4. 3. 5-3 , CLASS=CCNFORMANCE} 

{ This program tests if an end of line marker is inserted at the 
end of the line r if not explicitly done in the program. 
The structure of a text file requires a closing linemarker. 
Conforming compilers will either insert the linemarker, or 
report a run-time error e } 

program t6p4p3p5d3 (output: .) ,< 
var 

filel : text; 

chare : char; 
begin 

rewrite( filel) ; 

write(filel,'A'); 

reset (filel) ; 

get (filel); 

if eoln(filel) then writelnC PASS. . .6.4.3.5-3') 
else writeln(* FAIL. . .6.4.3.5-3') 
end. 
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{TEST 6.4.3.5-4, CLASS=C0NF0RM7VNCE} 

{ This program tests if an end-of-line marker is inserted at 
the end of the line on the predefined file output, if 
not explicitly done in the program (i.e. is the buffer 
flushed). See also test 6.4.3.5-3. } 

program t6p4p3p5d4 (output) ; 
begin 

writeC PASS... 6. 4. 3. 5-4') 
end. 



{TEST 6.4.4-1, CLASS=CONFORMANCE} 

{ This program simply tests that pointer types as described in the 
Pascal Standard are permitted. } 

program t6p4p4dl (output) ; 
type 



sett 


= set of 1..2; 


urray 


= array[1..3] of integer; 


rekord 


= record 




a : integer; 




b : boolean 




end; 


ptr9 


= Tsett; 


pureptr = Tpureptr; 


ptrl 


T integer; 


ptr2 


Treal; 


ptr3 


T boolean; 


ptr4 


. Tsett; 


ptr5 


T urray; 


ptr6 


T rekord; 


ptr7 


. pureptr; 


ptr8 


. Ptr9; 


begin 




new(pti 


:l); 


new(pti 


:2); 


new(pti 


:3); 


new(pti 


:4); 


new(pti 


:5); 


new(pti 


:6); 


new(pti 


:7); 


new(pti 


:3); 


writeli 


i(» PASS... 6. 4. 4-1') 


end. 
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{TEST 6.4.4-2, CLASS=DEVIANCE'} 

{ This program tests the diagnostic that should be produced by 
the compiler if the type to which a pointer points is not 
found. } 

program t6p4p4d2 (output) ; 
var 

pointerl : Treal; 

pointer2 : T rekord; 
begin 

new( pointerl); 

pointerl :=nil; 
• new(pointer2); 

pointer2:=nil; 

writelnC DEVIATES. . .^4,4-2 *> 
end. 



{TEST 6.4.4-3, CLASS=DEVIANCE} 

{ Pointers to items in the stack are not allowed. 
The^T symbol is not permit usd to act s^ an ops is :'■■•:•■: 
giving the reference to a variable. The compiler deviates. 
if the program compiler and prints DEVIATES. } 

program t6p4p4d3 (output)^ 
var 

p: T integer; 

x: integer; 
begin 

x:=10; 

p:=Tx; 

writelnC DEVIATES. . .6.4,4-3, POINTER'} 
end. 
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{TEST 6.4.5-1, CLASSOONFORMANCE} 

{ The Pascal Standard states that types designated at two or more 
different places in the program text are identical if the same 
type identifier is used at these places, or if different identifiers 
are used which have been defined to be equivalent to each other. 
This program simply tests that the compiler conforms to the 
Standard's description of identity. 
The compiler fails if the program does not compile. } 

program t6p4p5dl (output) ; 
type 

tl = array[1..5] of boolean; 

t2 = tl; 

t3 = t2; 
var 

a : tl; 

b : t2; 

c : t3; 
procedure identical (var a : tl; var b : t2; var c ; t3); 
begin 

a[l] :=true; 

b[l]:=false; 

c[lj :=true 
end; 

begin 

a[l] :=true; 

b[l]:=false; 

c[l]:=false; 

identical (a,b,c) ; 

identical (c, a, b) ; 

identical (b,c, a) ; 

writelnC PASS. .. 6.4.5-1') 
end. 
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{TEST 6.4.5-2, CLASSHDEVIANCE} 

{ This program simply tests that the compiler does not deviate 
from the Standard in the case of subranges of the same host 
being treated as identical. 

The program should fail to compile/ execute if the compiler 
conforms. } 

program t6p4p5d2 (output) ; 
type 

colour = (red r pink,orange,yellow,green,blue); 

subone = red.. yellow; 

subtwo = pink.. blue; 
var 

colourl : subone; 

colour2 : subtwo; 

procedure test (var coll ? subone); 
begin 

writelnC DEVIATES. , .6.4. 5-2') 
end; 

begin 

{ Although colourl and colour2 are compatible (i.^ t subor>e am 
subtwo are compatible), they are not identical, and the call 
to TEST should fail. } 

colour2:=pink; 

test (colour 2) 
end. 



{TEST 6.4.5-3, CLASS=DEVIANCB| 

{ This test is similar to 6.4.5-2, except that deviance in the 
case of arrays is tested.. 

The program should not compile/ execute if the compiler 
conforms. } 

program t6p4p5d3 (output) ; 
type 

urrayone = array[1..10] of char; 

urraytwo = array[1..10] of char; 
var 

arrayone : urrayone; 

arraytwo : urraytwo; 

procedure test(var urray : urrayone); 
begin 

writelnC DEVIATES. . .6.4.5-3*) 
end; 

begin 

{ The two arraytypes, urrayone and urraytwo, are not identical 
and hence the call to TEST should fail. } 

test (arraytwo) 
end. 
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{TEST 6.4.5-4, CLASS=DEVIANCE} 

{ This program is similar to 6.4.5-3, except that deviance in the 
case of records is tested. 

The program should fail to compile/execute if the compiler 
conforms. } 

program t6p4p5d4 (output) ; 
type 

recone = record 

a : integer; 
b : boolean 
end; 
rectwo = record 

c : integer; 
d : boolean 
end; 
var 

recordone : recone; 
record two : rectwo; 

procedure test(var rec : recone); 
begin 

writeln(* DEVIATES. . .6.4.5-4') 
end; 

begin 

{ Although the two record types are compatible, they 
are not identical, and hence the call to TEST 
should fail. } 
recordtwo.c:=0; 
r eco r d two . d : =tr ue ; 
test (record two) 
end. 
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{TEST 6.4.5-5, CLASS=DEVIANCE} 

{ Again, this test is similar to 6.4.5-4, except that deviance 
for pointers is tested. 

Although the two pointers in this example point to the same 
type, they are not identical. 
The compiler conforms if the program does not compile/ execute. } 

program t6p4p5d5 (output) ; 
type 

rekord = record 

a : integer; 
end; 

ptrone = f rekord; 

ptrtwo = t rekord; 
var 

ptrtorec : ptrone; 

ptrtorectoo : ptrtwo; 

procedure test (var ptr : ptrone); 
begin 

writelnC DEVIATES. . .6.4.5-5') 
end; 

begin 

new( ptrtorectoo) ; 

ptrtorectoo:=nil; 

test (ptrtorectoo) 
end. 



{TEST 6.4.5-6, CLASS=CONFQRMANC£} 

{ Two types are compatible if they are identical or if one is a 
subrange of the other, or if both are subranges of the same type. 
This program tests these points, but with only subranges of the 
same type having some overlap. 

If the message produced is incomplete, or the program does not 
compile, then the compiler fails.} 

program t6p4p5d6 (output) ; 
type 

colour = (red, pi nk,o range, yellow,green, blue, brown) ; 

colour too= colour; 
var 

coll : colour; 

col2 : colourtoo; 

subcoll : red.. yellow; 

subcol2 : orange.. blue; 
begin 

coll:=red;' 

col2:=red; 

if coll = col2 then write(» PA'); 

subcoll := red; 

if coll = subcoll then write('S'); 

subcol 1 : =yel low; 

subcol2 : =yel low; 

if subcoll = subcol2 then writeln( 'S. . .6.4.5-6') 
end. 
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{TEST 6.4.5-7, C£ASS=CONFORMANCE} 

{ This program tests that two subranges of the same type with 
no overlap are considered as compatible by the compiler. 
The compiler fails if the program does not compile. } 

program t6p4p5d7 (output) ; 
type 

color = (red,pink,orange,yellow,green,blue,brown) ; 
var 

coll : red.. yellow; 

col2 : green.. brown; 
begin 

coll :=yel low; 

col2:=green; 

if coll < col2 then writelnC PASS. ..6.4.5-7') 
else writelnC FAIL.. .6. 4.5-7* ) 
end. 
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{TEST 6.4.5-9, CLASS=CONFORMANCE} 

{ The Pascal Standard states that set types of compatible base- types 
are compatible. This program tests that this is so for this 
compiler. 
The compiler fails if the program does not compile. } 

program t6p4p5d9 (output) ; 
type 

colour = ( red, pink, orange, yellow,green, blue, brown) ; 
var 

setl : set of red.. orange; 

set2 : set of orange.. brown; 
begin 

setl : = [orange] ; 

set2: = [orange] ; 

if setl=set2 then writelnC PASS. . .6.4.5-9') 
else writelnC FAIL. . .6.4.5-9') 
end. 
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{TEST 6.4.5-8, CLASS==C0NF0RMANCE} 

{ The Pascal Standard states that string types with the same 
number of components are compatible. 
The compiler fails if the program does not compile. } 

program t6p4p5d8 (output) ; 
var 

stringl : packed array[1..4] of char; 
string2 : packed array[1..4] of char; 
begin 

stringl :='ABCD'; 
string2:='EFGH'; 
if 'ABC = 'ABC then 

if stringl O string2 then 

writelnC PASS. . .6.4.5-8') 
else 

writelnC FAIL.. .6.4.5-8') 
else 

writelnC FAIL. . .6.4.5-8') 
end. 
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{TEST 6.4.5-10, CLASS-DEVIANCE} 

{ Some implementations may have an implicit ordering 

between different types, and allow these to be compared etc., 
thus not conforming to the compatibility rules of the Pascal 
Standard . 

The compiler conforms if the program does not compile, or 
fails to run, } 

program t6p4p5dl0 (output) ; 
var 

colour : (red, green, blue) ; 
begin 

if red < then writelnC DEVIATES* . ,6.4.5-10') 
else writelnC DEVIATES. . .6.4.5-10') 
end. 



{TEST 6.4.5-11, CLASS=DEVIANCE} 

{ The Pascal Standard permits compatibility only between string 
types of the same number of components. 
Some compilers may allow compatibility between string types 

with different numbers of components, (see 6.1.7-4 and 6 ) 

The compiler conforms if the program does not compile. } 



O 
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program t6p4p5dll (output) ; 
begin 

if 'CAT' < 'HOUND' then writelnC DEVIATES, 
end. 



.6.4.5-11') 
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{TEST 6.4.5-12, CLASSKTONFORMANCE} 

{ If two types are declared equivalent, they inherit all properties 
in common, including operators and special attributes. This 
is decked by an analogue of type boolean. The compiler passes 
if the program compiles and prints PASS. } 

program t6p4p5dl 2 (output) ; 
const 

on=true; 

off=false; 
type 

log ical=boolean; 
var 

test: integer; 

bl,b2: boolean; 

11, 12: logical ; 
begin 

test:=0; 

bl:=true; b2:=off; 

ll:=true; 12:=off; 

if 12 then test:=test+l; 

12:=b2; 

if bl=b2 then test:=test+l; 

b2:=12; 

if b2 or 12 then test:=test+l; 

if test=0 then 

writelnC PASS. . .6.4.5-12, TYPES') 

else 

writeln(* FAIL. . .6.4.5-12, TYPES') 
end. 



{TEST 6.4.5-13, CLASS=DEVTANCE} 

{ This test is similar to 6.4.5-2, except that deviance in the 
case of arrays is tested. 

The program should not compile/execute if the compiler 
conforms. } 

program t6p4p5dl 3 (output) ; 
type 

urrayone = array[1..10] of boolean; 

urraytwo = array[1..10] of boolean; 
/ar 

arrayone : urrayone; 

arraytwo : urraytwo; 

procedure test (var urray : urrayone); 
Degin 

writelnC DEVIATES. . .6.4.5-13') 
?nd; 



>egin 



»nd. 



{ The two arraytypes, urrayone and urraytwo, are not identical 

and hence the call to TEST should fail. } 
test (arraytwo) 
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{TEST 6.4.6-1, CLASS=CONFORMANCE} 

{ This program tests that all assignment compatible types as 
described by the Pascal Standard, are permitted by this compiler. 
This program tests only those uses in assignment statements. 
All cases have been tested elsewhere, but are included here 
together for consistency. 

The compiler fails if one or more of the cases below 
are rejected. } 

program t6p4p6dl (output) ; 
type 

colour = (red, pink, yellow); 

rekord = record 

a : integer; 
b : boolean 
end; 
var 

i : 

J 

coll : 

col 2 : 

col 3 : 

col4 : 

urrayl 

urray2 

recordl 

record2 
begin 

i:=2; 

j:=i; 

coll :=yel low; 
col2:=coll; 
col3: = [pink] ; 
col4:=col3; 
urray2[l]:=0; 
urrayl [6 ] : =ur ray2 [1 ] ; 
recordl. a: =2; 
recordl. b:=true; 
record2:=recordl; 
writelnC PASS. . .6.4.6-1' 
end. 



integer; 

real; 

colour; 

pink.. yellow; 

set of colour; 

set of red.. pink; 

: array[1..6] of integer; 

: array[1..4] of integer; 

: rekord; 

: rekord; 
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{TEST 6.4.6-2, CLASS=CCNFORMANCE} 

{ This test is similar to 6.4.6-1, except that it tests the use 
of assignment compatibility in actual and formal parameters. 
The compiler fails if the program does not compile. } 

program t6p4p6d2 (output) ; 
type 

colour = (red,pink,yellow,green) ; 

subcoll = yellow. .green; 

subcol2 = set of colour; 

subcol3 = set of pink.. green; 
var 

a : integer; 

b : real; 

colour 1 : colour; 

colour2 : pink.. green; 

colour 3 : set of colour; 

colour4 : set of yellow. .green; 

procedure compat(i : integer; j : real; 

coll : colour; col2 : subcoll; 

col3 : subcol2; col4 : subcol3); 
begin 
end; 

begin 

compat(2,2.4,yellow,yellow, [pink] , [pink] ); 

a:=2; 

b:=3.1; 

colourl:=pink; 

colour 2 : =green; 

colour3: = [yellow] ; 

colour 4 : = [yellow] ; 

compat (a ,b , colour 1 ,colour2 , colour 3 ,colour4 ) ; 

compat ( a ,a ,colour2 ,colour2 ,colour4 ,colour4 ) ; 

writelnC PASS. . .6.4.6-2') 
end. 
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{TEST 6.4.6-3, CLASS CONFORMANCE} 

{ This program tests a part of 6.5.2.1, that states that an index 
expression is assignment compatible with the index type 
specified in the definition of the array type. 
The compiler fails if the program does not compile. } 

program t6p4p6d3 (output) ; 
type 

colour = ( red, pink ,0 rang e,yellow,green) ; 

intensity = (bright,dull) ; 
var 

arrayl : array[ yellow. .green] of boolean; 

array2 : array [colour] of intensity; 

array3 : array[1..99] of integer; 

colourl : red.. yellow; 

i : integer; 

begin 

arrayl [yellow] : =true; 

colourl : =yel low; 

arrayl [colourl] :=false; 

array2 [colourl] :=bright; 

array3[l]:=0; 

i:=2; 

array3[i*3+2]:=l; 

writelnC PASS. . .6.4.6-3') 
end. 

{TEST 6.4.6-4, CLASS=ERRORHANDLING) 

{ The Pascal standard says that if the two types in an assignment 
compatibility test (Tl and T2) are compatible ordinal types 
and the value of the expression E which is of type T2 is not in 
the closed interval specified by the type Tl, an error occurs. 
Does this compiler detect this. } 

program t6p4p6d4 (output) ; 
type 

subrange = 0. .5; 
var 

i : subrange; 
begin 

i:=5; 

i:=i*2; { error } 

writelnC ERROR NOT DETECTED. . .6.4.6-4 ') 
end. 
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{TEST 6.4.6-5, CLASS=ERRORHANDLING } 

{ This program is similar to 6.4.6-4, except that parameter 
assignment compatibility is tested. 
The program causes an error to occur which should be detected. } 

program t6p4p6d5 (output) ; 
type 

subrange = 0..5; 
var 

i : subrange; 
procedure test (a : subrange); 
begin 

a:=5 
end; 

begin 

i:=5; 

test(i*2); { error } 

writelnC ERROR NOT DETECTED. . .6.4.6-5') 
end. 
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{TEST 6.4.6-7, CLASS=ERRORHANDLING } 

{ Similarly for 5.4.6-4, if two types are compatible set types, 
and any of the members of the set expression E (of type T2) 
is not in the closed interval specified by the base- type of the 
type Tl, an error occurs. 
Again, does the compiler detect this. } 

program t6p4p6d7 (output) ; 
type 

colour = (red , pink, orange,yellow,green,blue) ; 

subone = red.. orange; 

subtwo = pink.. yellow; 
var 

setone : set of subone; 

settwo : set of subtwo; 
begin 

settwo : = [pink, yellow] ; 

setone :=settwo; { should be an error } 

writelnC ERROR NOT DETECTED. . .6.4.6-7*) 
end. 
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{TEST 6.4.6-6, CIASS=ERRORHANDLING } 

{ This program is similar to 6.4.6-4, except that array 
subscript assignment compatibility is tested. 
The program causes an error, which should be detected. } 

program t6p4p6d6 (output) ; 
type 

colour = ( red, pink, orange, yel low,green) ; 
var 

v : colour; 

urray : array[ red.. orange] of boolean; 
begin 

v:=orange; 

urray[succ(v)] :=true; { error } 

writelnC ERROR NOT DETECTED. . .6.4.6-6*) 
end. 
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{TEST 6.4.6-8, CLASS=ERRORHANDLING} 

{ This test is similar to 6.4.6-7, except that assignment 
compatibility for sets passed as parameters is tested. 
The program causes an error which should be detected. } 

program t6p4p6d8 (output) ; 
type 

colour = ( red, pink, orange, yel low, green,blue) ; 

subone = red.. green; 

settwo = set of yellow. .blue; 
var 

setone : set of subone; 
procedure test (a : settwo); 
begin 
end; 

begin 

setone : = [ red, pink, orange] ; 

test (setone) ; 

wr i tel n (' ERROR NOT DETECTED. ..6.4.6-8*) 
end. 
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(TEST 6.4.6-9, CLASS=DEVIANCE} 

{ The Pascal Standard allows assignment of integers to reals, 
but not reals to integers. 

Does this compiler allow assignment of reals to integers. 
If so, it does not conform to the Standard. 
The compiler conforms if the program does not compile. } 

program t6p4p6d9 (output) ; 
var 

i : real; 

j : integer; 
procedure test (a: integer) ; 
begin 
end; 

begin 

i:=6.345; 

test (6.345) ; 

writelnC DEVIATES. ..6. 4.6-9* ) 
end. 
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{TEST 6.4.6-11, CLASS=DEVIANCE} 

{This program tests the latter half of the statement in 
6.4.6-10. 
The compiler conforms if the program does not compile. } 

program t6p4p6dll (output) ; 
type 

rekord = record 

f : text; 
a : integer 
end; 
var 

recordl : rekord; 

record2 : rekord; 
begin 

recordl. a :=1; 

reset ( recordl. f) ; 

rewr i te ( record2 . f ) ; 

wr i tel n ( recordl . f ) ; 

record2 : =recordl ; ; 

writelnC DEVIATES. . .6.4.6-11') 
end. 
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{TEST 6.4.6-10, CLASSHDEVIANCE} 

{ The Pascal Standard states that the two types Tl and T2 
(in determining assignment compatibility) must neither be 
a file type nor a structured type with a file component. 
This program tests the first part of this statement. 
The compiler conforms if the program does not compile. } 

program t6p4p6dl0 (output) ; 
var 

filel : text; 

file2 : text; 
begin 

reset (filel); 

rewrite (file2); 

writelntfileVABC 1 ); 

file2:=filel; 

writelnC DEVIATES. ..6.4. 6-10 1 ) 
end. 
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{TEST 6.4.6-12, CLASS=DEVTANCE} 

{ The standard specifies that a filetype T2 cannot be 

assignment-compatible with an identical type Tl, nor can a 
structure containing such a filetype. This precludes any 
assignments involving files. The compiler deviates if the program 
compiles and prints DEVIATES. } 

program t6p4p6dl 2 (output) ; 
var 

fl,f2:text; 
begin 

rewrite (fl); 

writeln(fl,» DEVIATES 1 ); 

writelnC DEVIATES. . .6.4.6-12, FILES'); 

f2:=fl; 
end. 
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[TEST 6.5.1-1, CIASS=CONFORMANCE} 

[ Here is included two examples from the Pascal Standard. 
The first is from section 6.4.7, and consists of legal type 
declarations. The second is from section 6.5.1, and consists 
of legal variable declarations. 
The compiler fails if the program does not compile. } 

program t6p5pldl (output) ; 
type 



count 


= integer; 


range 


= integer; 


colour 


= (red,yellow,green r blue); 


sex 


= (male, female) ; 


year 


= 1900.. 1999; 


shape 


= (triangle,rectangle,circle); 


card 


= array[1..80] of char; 


str 


= file of char; 


angle 


- real; 


polar 


= record 




r : real; 




theta : angle 




end; 


person 


= f persondetails; 


persondetails = record 




name, firstname : str; 




age : integer; 




married : boolean; 




father, child, sibling : person; 




case s:sex of 




male : (enlisted, bearded : boolean); 




female : (pregnant : boolean) 




end; 


tape 


= file of persondetails; 


intfile 


= file of integer; 


var 




x,y,z 


: real; 


irj 


: integer; 


k 


: 0..9; 


P/q,r 


: boolean; 


operator 


: (plus ,minus, times) ; 


a 


: array[0..63] of real; 


c 


: colour; 


f 


: file of char; 


hue 1, hue 2 : set of colour; 


pl,p2 


: person; 


m,ml,m2 


: polar; 


pool tape 
begin 

writeln( 


: array[1..4] of tape; 


' PASS... 6. 5. 1-1') 


end. 
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{TEST 6.5.1-2, CLASS=QUALITY} 

{ This test checks that long declaration lists are allowed by 
the compiler. The test may detect a small compiler limit . } 

program t6p5pld2 (output) ; 
var 

i0,il,i2,i3,i4,i5,i6,i7,i8,i9, 

il0,ill,il2,il3,il4,il5,il6,il7,il8,il9, 

i20,i21,i22,i23,i24,i25,i26,i27,i28,i29, 

i30,i31,i32,i33,i34,i35,i36,i37,i38,i39, 

i40,i41,i42,i43,i44,i45,i46,i47,i48,i49, 

i50,i51,i52,i53,i54,i55,i56,i57,i58,i59, 

i60,i61,i62,i63,i64,i65,i66,i67,i68,i69, 

i70,i71,i72,i73,i74,i75,i76,i77,i78,i79, 

i80,i81,i82,i83,i84,i85,i86,i87,i88,i89, 

i90 , i91 , i92 , i93 , i94 , i95 , i96 , i97 , i98 , i99 

: integer; 
begin 

i0:=0; il :=1; i2:=2; i3:=3; i4: 
il0:=i0+l; ill:=il+l; il2:=i2+li 
il5:=i5+l; il6:=i6+l; il7:=i7+l; 
i20:=il0+i0; i21:=ill+il; i22:= 
i25:=il5+i5; i26:=il6+i6; i27:= 
i30:=i20+il0; i31:=i21+ill; i32 
i35:=i25+il5; i36:=i26+il6; i37 
i40:=i30+i20; i41:=i31+i21; i42 
i45:=i35+i25; i46:=i36+i26; i47 
i50:=i40+i30; i51:=i41+i31; i52 
i55:=i45+i35; i56:=i46+i36; i57 
i60:=i50+i40; i61:=i51+i41; i62 
i65:=i55+i45; i66:=i56+i46; i67 
i70:=i60+i50; i71:=i61+i51; i72 
i75:=i65+i55; i76:=i66+i56; i77 
i80:=i70+i60; i81:=i71+i61; i82 
i85:=i75+i65; i86:=i76+i66; i87 
i90:=i80+i70; i91:=i81+i71; i92 
i95:=i85+i75; i96:=i86+i76; i97 
iO : =190+i91+i92+i93+i94+i95+i96+i97+i98+i99; 
if (i0=2815) then 

writelnC LONG DECLARATIONS ALLOWED. . .6.5.1-2') 
else 

wr i tel n ( ' LONG DECLARATIONS NOT ALLOWED. ..6.5.1-2'); 
end. 



=4; i5:=5; i6:=6; i7:=7; 

il3:=i3+l; il4:=i4+l; 

il8:=i8+l; il9:=i9+l; 
12+i2; i23:=il3+i3; i24: 
17+i7; i28:=il8+i8; i29: 



i22+il2 
=i27+il7 
=i32+i22 
=i37+i27 
=i42+i32 
=i47+i37 
=i52+i42 
=i57+i47 
=i62+i52 
=i67+i57 
=i72+i62 
=i77+i67 
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=i87+i77 



i33:=i23+il3 
i38:=i28+il8 
i43:=i33+i23 
i48:=i38+i28 
i53:=i43+i33 
i58:=i48+i38 

i63:=i53+i43 
i68:=i58+i48 
i73:=i63+i53 
i78:=i68+i58 
i83:=i73+i63 
i88:=i78+i68 
i93:=i83+i73 
i98:=i88+i78 



i8:=8; i9:=9; 



=il4+i4; 

=il9+i9; 

i34:=i24+il4 

i39:=i29+il9; 

i44:=i34+i24 

i49:=i39+i29 

i54:=i44+i34 

i59:=i49+i39, 

i64:=i54+i44 

i69:=i59+i49 

i74:=i64+i54 

i79:=i69+i59, 
i84:=i74+i64 
i89:=i79+i69, 
i94:=i84+i74 
i99:=i89+i79 
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{TEST 6.5.3.2-1, CLASS=ERRQRHANDLING } 

{ This test is similar to 6.4.5-6, except that a two 
dimensional array is used. This may present some problems to 
particular implementations. } 

program t6p5p3p2dl (output) ; 
var 

urray : array[1..10,1..10J of integer; 

i : integer; 

begin 

i:=3; 

urray[i*2,i*4]:=0; 

writelnC ERROR NOT DETECTED... 6. 5. 3. 2-1') 
end. 
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{TEST 6.5.3.2-2, CLASS=C0NF0RMANCE} 

{ This test checks that the two ways of indexing a multi-dimensional 
array are equivalent. The compiler fails if the program does 
not compile and print PASS.} 

program t6p5p3p2d2 (output) ; 
var 

a:array[1..4,1..4] of integer; 
b:array[1..4] of 

array[1..4] of integer; 
prpacked array [1..4,1. .4]of char; 
qrpacked array[1..4] of 

packed array [1..4] of char; 
i , j ,counter : integer; 
begin 

counter :=0; 
for i:= 1 to 4 do 
for j :=1 to 4 do 
begin 

a[i,jl := j; 
b[i,j] := j; 
case j of 
1: 
begin 

p[i,j]: = 'F'; 
q[i,j3:='F'; 
end; 
2: 
begin 

p[i,jJ: = *A'; 

end; 
3: 
begin 

p[i,j]:='I'; 
q[i,j]:='I'; 
end; 
4: 
begin 

p[i,j]:=»L'; 
q[i,jJ:=»L'; 
end; 
end; 
end; 
for i:=l to 4 do 
for j:=l to 4 do 
begin 

if a[i] [j] O a[i,j] then 

counter :=counter+l; 
if b[i][j] O b[i,j] then 

coun ter : =counter+l ; 
if p[i][jl <> Pfi,j] then 

counter :=counter+l; 
if qfiHj] O q[i,j] then 
counter : =counter+l ; 
end; 
if counter=0 then 

writelnC PASS. ..6.5.3.2-2, INDEXING 1 ) 
else 

writelnC FAIL. . .6.5.3.2-2, INDEXING 1 ) 
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end. 



{TEST 6.5.3.4-1, CLASS=CONFORMANCE} 

{ The Pascal Standard states that the existance of a file 
variable f with components of type T implies the existence 
of a buffer variable of type T. 

Only the one component of a file variable determined by the 
current file position is directly accessible. 
The program tests that file buffers may be referenced in this 
implementation. 
The compiler fails if the program does not compile. } 

program t6p5p3p4dl (output) ; 
type 

rekord = record 

urray : array[1..2] of char; 
a : integer; 
b : real 
end; 
var 

fyle : file of rekord; 
begin 

rewrite (fyle) ; 
fyleT.urray[l]:= , , ; 
fyleT.urray[2]:='K»; 
fyleT.a:=10; 
fyle? .b:=2. 345; 
put (fyle); 
with fylet do 
begin 

urray[l] :='0'; 
urray[2]:= , K l ; 
a:=4; 
b:=3.456 
end; 

put ( fyle) ; 

writelnC PASS. ..6.5.3.4-1') 
end. 
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{TEST 6.5.4-1, CLASS=ERRORHANDLING} 

{ The Pascal Standard states that an error occurs if a pointer 
variable has a value NIL at the time it is dereferenced. 
This program tests that the error is detected. The diagnostic 
should be checked for suitability. } 

program t6p5p4dl (output) ; 
type 

rekord = record 

a : integer; 
b : boolean 
end; 
var 

pointer : T rekord; 
begin 

pointer :=nil; 
pointerT.a:=l; 
pointer? .b:=true; 

writelnC ERROR NOT DETECTED. . .6.5.4-1') 
end. 



{TEST 6.5.4-2, CLASS=ERRORHANDLING} 

{ Similarly to 6.5.4-1, an error occurs if a pointer variable 
has an undefined value when it is dereferenced. } 

program t6p5p4d2 (output) ; 
type 

rekord = record 

a : integer; 
b : boolean 
end; 
var 

pointer : T rekord; 
begin 

pointerT.a:=l; 
pointer? .b:=true; 

writelnC ERROR NOT DETECTED. . .6.5.4-2*) 
end. 
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integer; h : real); 



{TEST 6.6.1-1, CIASS=CONFORMANCE} 

{ This program simply tests the syntax for procedures as defined 
by the Pascal Standard. 
The compiler fails if the program does not compile. } 

program t6p6pldl (output) ; 
var 

a : integer; 

b : real; 
procedure withparameters(g 
var 

c : integer; 

d : real; 
begin 

c:=g; 

d:=h 
end; 

procedure parameter less; 
begin 

write (» PASS 1 ) 
end; 

begin 

a:=l; 

b:=2; 

withparameters(a,b) ; 

parameterless; 

writeln( , ...6.6.1-l i ) 
end. 



00335600 
00335700 
00335800 
00335900 
00336000 
00336100 
00336200 
00336300 
00336400 
00336500 
00336600 
00336700 
00336800 
00336900 
00337000 
00337100 
00337200 
00337300 
00337400 
00337500 
00337600 
00337700 
00337800 
00337900 
00338000 
00338100 
00338200 
00338300 
00338400 
00338500 
00338600 



{TEST 6.6.1-2, CLASS=CONFOf^MANCE} 

{ This program tests the implementation of FORWARD declaration, 
recursive activation, and multilevel referencing of a var 
parameter in procedures. 
The compiler fails if the program will not compile. } 

program t6p6pld2 (output) ; 
var 

c : integer; 

procedure one(var a : integer) ; 
forward; 

procedure two (var b : integer); 
begin 

b:=bfl; 

one(b) 
end; 

procedure one; 
begin 

a:=a+l; 

if a = 1 then two (a) 
end; 

begin 

c:=0; 

one ( c) ; 

if c = 3 then 

writelnC PASS. . .6.6.1-2') 
end. 
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TEST 6.6.1-4, CLASS=DEVTANCE} 

This program tests if the compiler allows the formal parameter 
list to be included in the subsequent procedure declaration of 
a forward procedure. 

The compile conforms to the Standard if the program does not 
compile. } 

rogram t6p6pld4 (output) ; 
ar 

c : integer; 

rocedure one(var a : integer); 
forward; 

rocedure two(var b : integer); 
egin 

b:=fc*l; 

one(b) 
nd; 

rocedure one(var a : integer); 
egin 

a:=a+l; 

if a = 1 then two (a) 
nd; 

egin 

c:=0; 

one(c); 

writelnC DEVIATES. ..6.6. 1-4') 
nd. 
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{TEST 6.6.1-5, CLASS=DEVIANCE} 

{ If the compiler permits the formal parameter list to be included 
in the subsequent procedure declaration of a forward procedure 
(6.6.1-4), does it check the parameter list is the same ? 
The compiler deviates if the program compiles, and only conforms 
if the second formal parameter list is flagged as an error. } 

program t6p6pld5 (output) ; 
var 

c : integer; 

procedure one (var a : integer); 
forward; 

procedure two (var b : integer); 
begin 

b:=bfl; 

one(b) 
end; 

procedure one(a : integer); 
begin 

a:=a+l; 

if a = 1 then two (a) 
end; 

begin 

c:=0; 

one(c) ; 

writelnC DEVIATES. . .6.6.1-5') 
end. 
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{TEST 6.6.1-6, CLASS=DEVIANCE} 

{ This program tests the compilers actions for a procedure declared 
as forward, but no matching subsequent procedure declaration 
for the forward procedure occurs. } 

program t6p6pld6 (output) ; 
var 

c : integer; 

procedure two(var b : integer); 
forward; 

procedure one(var a : integer); 
begin 

a:=a+l; 

if a = 1 then two (a) 
end; 

begin 

c:=0; 

one(c) 

writelnC DEVIATES. . .6.6.1-6, FORWARD PROCEDURE'); 
end. 
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{TEST 6.6.1-7, CLASS=QUALITY} 

{ This test checks that procedures may be nested to 15 levels. 
The test may detect a small compiler limit. The limit may 
arise due to failure of a register allocation scheme, a limited 
reserved size for a display, or a field set aside for lexical 
level information, or some combination of these. } 

program t6p6pld7 (output) ; 
var 

i: integer; 

procedure pi; 
procedure p2; 
procedure p3; 
procedure p4; 
procedure p5; 
procedure p6; 
procedure p7; 
procedure p8; 
procedure p9; 
procedure plO; 
procedure pll; 
procedure pl2; 
procedure pl3; 
procedure pl4; 
procedure pi 5; 
begin 

i:=i+l; 
end; 
begin 
P15 
end; 
begin 
pl4 
end; 
begin 
pl3 
end; 
begin 
pl2 
end; 
begin 
pll 
end; 
begin 
plO 
end; 
begin 

P9 
end; 
begin 
P 8 
end; 
begin 
P7 
end; 
begin 
P 6 
end; 
begin 
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J 35 
end; 

begin 

P 4 

end; 

begin 

p3 

end; 

begin 

P2 

begin 

i:=0; 

Pi; 

writelnC 
end. 



NESTED PROCEDURES TO 15 LEVELS IMPLEMENTED. . .6.6.1-7' 
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{TEST 6.6.2-1, CLASS=CONFORMANCE} 

{ This program simply tests the syntax for functions as defined 
by the Pascal Standard. 
The compiler fails if the program does not compile. } 

program t6p6p2dl (output) ; 
var 

a , 

twopi squared : real; 

b : integer; 

function power (x : real; y : integer) : real; { y>=0 } 
var 

w,z : real; 
i : 0..maxint; 
begin 
w:=X; 
z:=l; 
i:=y; 

while i > do 
begin 

{ z*(w tothepower i)=x tothepower y } 
if odd(i) then z:=z*w; 
i:=i div 2; 
w:=sqr(w) 
end; 

{ z=x tothepower y } 
power :=z 
end; 

function twopi : real; 
begin 

twopi: =6. 283185 
end; 

begin 

a:=twopi; 

b:=2; 

twopisquared:=power(a,b) ; 

writelnC PASS. . .6.6. 2-1") 
end. 
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{TEST 6.6.2-2, CLASS=CONFORMANCE} 

{ Similarly to 6.6.1-2 f functions may be declared as forward. 
This program tests that forward declaration and recursion in 
functions is permitted. 
The compiler fails if the program does not compile. } 

program t6p6p2d2 (output) ; 
var 

c : integer; 
function one (a 

forward; 



integer) : integer; 
integer) : integer; 



function two(b : 
var 

x : integer; 
begin 

x:=b+l; 

x:=one(x) ; 

two:=x 
end; 



function one; 
var 

y : integer; 
begin 

y:=a+l; 

i f y=l then y : =two ( y) ; 

one:=y 
end: 

begin 

c:=0; 

c:=one(c) ; 

if c = 3 then 

writelnC PASS. . .6.6.2-2*) 
end. 
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{TEST 6.6.2-3, CIASS=CONFORMANCE} 

{ The Pascal Standard specifies that the result type of a function 
can only be a simple type or a pointer type. 

This program checks that the simple types and pointer types are 
permitted. 
The compiler fails if the program does not compile. } 

program t6p6p2d3 (output) ; 
type 

subrange = 0..3; 

enumerated = (red, yellow, green) ; 

rectype = record 

a : integer 
end; 
ptrtype = f rectype; 
var 

real ; 

integer; 

boolean; 

subrange; 

enumerated; 

char; 

ptrtype; 



real; 



integer; 



function one 
begin 

one: =2. 63 
end; 

function two 
begin 

two: -2 
end; 

function three : boolean; 
begin 

three :=false 
end; 

function four : subrange; 
begin 

four: -2 
end; 

function five : enumerated; 
begin 

five:=yellow 
end; 

function six : char; 
begin 

six:^ 1 
end; 

function seven 
begin 

seven :=nil 
end; 

begin 

a:=one; 

b:=two; 

c:=three; 

d:=four; 

e:=five; 

f :=six; 



ptrtype; 
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g:=seven; 

writeln(» PASS. ..6.6.2-3') 
end. 



{TEST 6,6.2-4, CIASS=DEVTANCE} 

{ This program tests the compilers actions when the type of 
result returned by a function is not a simple type. 
All the cases should be rejected by the compiler if it 
conforms to the Standard. } 

program t6p6p2d4 (output) ; 
type 

wrekord = record 

a : integer; 
b : boolean 
end; 
sett = set of 0..3; 
urray = array[1..3] of char; 
var 

recordl : wrekord; 
setl : sett ; 
arrayl : urray; 

function one : sett; 
begin 

one:=[0..3j 
end; 

function two : urray; 
begin 

twor^ABC 
end; 

function three : wrekord; 
var 

rekord : wrekord; 
begin 

rekord.a:=l; 

rekord.b:=true; 

three :=rekord 
end; 

begin 

recordl :=one; 

setl:=two; 

arrayl :=three; 

writelnC DEVIATES. . .6.6. 2-4') 
end. 
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{TEST 6.6.2-5, CLASS=DEVTANCE} 

{ The Pascal Standard specifies that at least one assignment 
statement which assigns a value to the function identifier 
must occur in the function block. 
Does the compiler permit a function declaration with 
no assignment to the function identifier? 
The compiler deviates if it does. } 

program t6p6p2d5 (output) ; 
var 

a : integer; 
function illegal (var b : integer) : integer; 
var 

x : integer; 
begin 

x:=b*2 
end; 

begin 

a:=2; 

a:=illegal(a); 

writelnC DEVIATES. ..6.6.2-5') 
end. 



{TEST 6.6.2-6, CLASS=ERRORHANDLING} 

{ The Pascal Standard states that the result of a function will 
be the last value assigned to its identifier. If no assignment 
occurs then the result is undefined. 

This program contains a function with an assignment to its 
identifier, however the assignment is never executed. An error 
should occur during execution. } 

program t6p6p2d6 (output) ; 
var 

radius , 

circlearea : real; 
function area (a : real) : real; 
var 

x : real; 
begin 

if a > then x:=3.1415926*a*a 
else area:=0 
end; 

begin 

radius: =2; 

circlearea :=area ( rad ius) ; 

writelnC ERROR NOT DETECTED. . .6.6.2-6') 
end. 
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{TEST 6.6.2-7, CLASS=CONFORMANCE} 

{ This test checks that functions are not prohibited from altering 
their environment (ie. side effects). Though side effects are 
generally not to be encouraged, they are part of standard Pascal 
and do have genuine uses. Functions with side effect occur 
el severe in the validation suite. } 

program t6p6p2d7 (output) ; 
type 

ptrtochar = Tchar; 
var 

cl,c2,c3, dummy :char; 

pi, p2: ptrtochar; 

function testa (ptrrptrtochar) :char; 

{sneakiest, uses pointers} 
var 

pp: ptrtochar; 
begin 

pp:=ptr; 

ppt : = 'P ! ; 

testa : = M 3 
end i 

procedure assign; 

(used by testb] 
begin 

cls=*A' 
end; 

function testb: char; 

{sneaky, calls a procedure} 
begin 

assign; 

testb:='2' 
end; 

function teste :char; 

{blatantly changes the environment via write} 
begin 

writeC ' ,pH,cl,c2,c3,p2T) ; 

testc^^' 
end; 

function testd: ptrtochar; 

{blatantly sneaky: modifying the environment via new 
and then passing it out} 
var 

pp: ptrtochar; 
begin 

new(pp); 

PPT:='.'; 

testd : =pp 
end; 

function teste: char; 

{the most used side ef fect:global access} 
begin 

c2:='S'; 

teste:='3' 
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end; 

function testf (var crchar) :char; 

{straightforward} 
begin 

ct^S 1 ; 

testf:='4' 
end; 

begin {of main program} 

new(pl); 

plTt^'F'; cl:='A'; c2:= , I'; c3:='L'; 

p2:=nii; 

{which defines all variables} 

dummy : =testa ( pi ) ; 

dummy :=testb; 

dummy := teste; 

dummy : =testf ( c3 ) ; 

p2:=testd; 

dummy := teste; 

writeln(*..6.6.2-7, ENVIRONMENT') 
end. 
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(TEST 6,6.3.1-1, CLASS^CONFQRMANCE} 

{ This program tests that parameters as described by the Pascal 
Standard are permitted by the compiler, especially long 
identifier lists. A parameter list with 30 elements is thought 
long enough to test most applications using procedure/ function 
parameter lists. This test occurs elsewhere in the suite, but 
is included here for consistency. 
The compiler fails if the program does not compile. } 

program t6p6p3pldl (output) ; 
type 

colour = ( red, orange, yellow,green, blue, brown); 

subrange = red . . blue ■; 

rekord = record 

a : integer 
end; 

ptrtype = f rekord; 
var 

a,b,c,d,e,f ,g r h,i,j, 

k,l,m,n,o,p,q,r,s,t : integer? 

colone : colour; 

col two : colour; 

col three : colour; 

u,v,w,x : real; 

y,z : boolean? 

ptr : ptrtype; 

procedure testone(al ,bl ,cl ,dl , el , f 1 , gl -hi , i 1, jl e k.I , 

ll,ml,nl,oi,pl f ql,rl,sl,tl : integer; 

colourone : subrange? 

colour two, colour three : colour; 

ul,vl,wl,xl : real; 

yl/Zl : boolean; 

ptr : ptrtype); 
begin 

write(« PASS') 
end; 
procedure testtwo(var al,bl,cl,dl,el,fl,gl,hl,il, jl,kl, 

ll,ml,nl,ol,pl,ql,rl,sl,tl : integer; 

var colourone : subrange; 

var colour two, colour three : colour; 

var ul,vl,wl,xl : real; 

var yl,zl : boolean; 

var ptr : ptrtype) ; 
begin 

writelnC... 6.6. 3.1-1') 
end; 
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begin 

a:=0; b 

h:=0; i 

o:=0; p:=0; q:=0; r: 

colone :=orange; 

coltwo:=brown; 

colthree:=red; 

u:=0; v:=0; w:=0; x:=0; 

y:=true; 

z:=false; 
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new (ptr) ; 

testone(a,b,c,d,e,f ,g,h,i,j,k,l,m,n,o,p,q,r,s,t, 
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colone,coltwo,colthree,u,v,w,x,y,z,ptr) ; 
test two ( a , b ,c ,d , e , f ,g ,h , i , j ,k , 1 ,m , n , o , p ,q , r , s , t , 
colone,coltwo,colthree,u,v,w,x,y,z,ptr) ; 
end. 



{TEST 6.6.3.1-2, CLASS=CCNFORMANCE} 

{ This program is similar to 6.6.3.1-1, except that set, 
record and array parameter lists are tested. 
The compiler fails if the program does not compile. } 

program t6p6p3pld2 (output) ; 
type 

sett = set of 0..20; 

rekord = record 

a : integer 
end; 

urray = array [boolean] of boolean; 
var 

setone, settwo,setthree,setfour,setfive,setsix : sett; 

recone,rectwo,recthree,recfour,recfive : rekord; 

urrayone,urraytwo,urraythree,urrayfour : urray; 

procedure testone(setl,set2,set3,set4,set5 f set6 : sett; 

recl,rec2,rec3,rec4,rec5 : rekord; 

urrayl,urray2,urray3 f urray4 : urray); 
begin 

"writer PASS 1 ) 
end; 

procedure testtwo(var setl,set2,set3,set4,set5,set6 : sett; 



begin 

writeln(* 
end; 



var recl,rec2,rec3,rec4,rec5 : rekord; 
var urrayl,urray2,urray3,urray4 : urray); 

.6.6.3.1-2') 



begin 

setone:=[l]; 
setfour:=[l]; 
recone.a:=l; 
recfour.a:=l; 



settwo:=[l]; setthree:=[lj; 

setfive:=[l]; setsix:=[l]; 

rectwo.a:=l; recthree.a:=l; 
recfive.a:=l; 



end 



urrayone[true] :=false; urraytwo[true] :=false; 
urraythree[true] :=false; urrayfour[true] :=false; 

testone(setone,settwo,setthree,setfour,setfive,setsix, 
recone,rectwo, rec three,recfour, reef ive, 
urrayone,urraytwo,urraythree,urrayfcur); 

testtwo(setone,settwo,setthree,setfour,setfive,setsix, 
recone , rec two , rec three , rec four , reef ive , 
urrayone,urraytwo,urraythree,urrayfour) ; 
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{TEST 6.6.3.1-3, CLASS=C0NF0RN1ANCE} 

{ This program tests that files may be passed to 
procedures as parameters, as a file is a type, and any 
type may be passed as a parameter. 
The compiler fails if the program does not compile. } 

program t6p6p3pld3 (output) ; 
type 

fyle = text; 
var 

elyf : fyle; 
procedure test(var anyfile : fyle); 
begin 

rewrite (anyfile) ; 

writeln( anyfile,' THIS FILE WAS A PARAMETER'); 

writelnC PASS. . .6.6.3.1-3') 
end; 
begin 

test (elyf) 
end* 



{TEST 6.6.3.1-4, CLASS=DEVIANCE> 

{ The occurrence of an identifier within an identifier list of 
a parameter group is Its defining occurence a:? a parameter 
identifier for the formal parameter list in which it. occurs 
and any corresponding procedure block or function block. 
This precludes the declaration of a local variable with the same 
name as an identifier in the formal parameter list. 
Does the compiler detect this as an error,- or allow it 
to occur with some form of side effect? 
The compiler conforms if the program does not compile. } 

program t6p6p3pld4 (output) ; 
var 

i : integer; 
procedure deviates(var x : integer); 

var x : integer; 
begin 

x:=2*x; 

writelnC DEVIATES. . .6.6.3.1-4 : x=',x) 
end', 
procedure deviatesl(x : integer); 

var x : integer; 
begin 

x:=0; 

x:=2*x; 

writelnC DEVIATES. . .6.6.3.1-4 : x=',x) 
end; 

begin 
i:=5; 

deviates ( i) ; 
i:=5; 

deviatesl (i) 
end. 
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{TEST 6.6.3.1-5, CLASS=CONFCBMANCE} 

{ When a procedure (or function) with a parameter list is 
included in the formal parameter list of another procedure 
(or function) , the identifiers in the parameter list of the 
procedure parameter have defining occurences for that list 
and the corresponding block for the procedure only, and not 
for the block of the procedure to which it is passed. 
The example in this program should be passed by the compiler. 

program t6p6p3pld5 (output) ; 
var 

i : integer; 
procedure alsoconforms(x : integer); 
begin 

writelnC PASS. ..6.6.3.1-5') 
end; 

procedure conforms (procedure alsoconforms(x : integer)); 

var x : boolean; 
begin 

x:=true; 

alsoconforms(l) 
end; 

begin 

i:=2; 

conforms (alsoconforms(i) ) 
end. 



{TEST 6.6.3.2-1, CIASS=CONFORMANCE} 

{ This program would have tested that the actual parameters to 

a procedure/ function are assignment compatible with the type 

of the formal parameter. 

However, this test is carried out by test 6.4.6-2, and the 

user is refered to there. } 
program t6p6p3p2dl; 
begin 
end. 
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.3.3- 



CLASS=€ONFQRMANCE} 



integer; var result : boolean); 



{ The Pascal Standard states that any operation involving the 
formal parameter is performed immediately on the actual 
parameter. Depending on how variable parameter passing is 
implemented, this test may cause some compilers to fail. 
The compiler fails if the program does not compile, or the 
program states that this is so. } 



program t6p6p3p3d2 (output) ; 
var 

direct : integer; 
pass : boolean; 
procedure indirect ion (var indirect 
begin 

indirect:=2; 

if indirectOdirect then 

result:=false 
else 

result :=true 
end? 
begin 

direct:-!; 
pass:=false; 

indirection(direct,pass) ; 
if pass then 

writeln(* PASS. , .6.6. 3. 3-2'} 
else 

writelnC FAIL. . .6.6. 3.3-2') 
end* 
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{TEST 6.6.3.3-1, CLASS=C0NF0RMANCE} 

{ This program would have tested that the actual parameters to 

a procedure/ function are identical to the type of the formal 

parameters . 

This test is carried out by program 6.4.5-1, and the user is 

refered to there. } 
program t6p6p3p3dl; 
begin 
end. 
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{TEST 6.6.3.3-3, CL?^SS=CONFORMANCE} 

{ If the variable passed as a parameter involves the indexing 
of an array, or the dereferencing of a pointer, then these 
actions are executed before the activation of the block. 
The compiler fails if the program does not compile or the 
program states that this is so. } 

program t6p6p3p3d3 (output) ; 
type 

rekord = record 

a : integer; 
link : T rekord; 
back : T rekord 
end; 
var 

urray : array [1.. 2] of integer; 
i : integer; 

temptr,ptr : T rekord; 
procedure call(arrayloctn : integer; 
ptrderef : integer) ; 
begin 

i:=i+l; 

ptr:=ptr?.link; 

if (urray[i-l] O arrayloctn) or 
(ptrT .backf .a <> ptrderef) then 
writelnC FAIL.. .6.6.3.3-3') 
else 

writeln(» PASS. . .6.6.3.3-3') 
end; 
begin 

urray[l]:=l; 
urray[2] :=2; 
i:=l; 
new(ptr) ; 
ptrT.a:=l; 
new ( tempt r) ; 
temptrT.a:=2; 
ptr T . 1 ink : =temptr ; 
temptr? .back:=ptr; 
call(urray[i] ,ptrf.a) 
end. 
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{TEST 6.6.3.4-1, CLASS=CONFORMANCE} 

{ This program tests that procedures may be passed to other 
procedures and functions as parameters. 
The compiler fails if the program does not compile and run. } 

program t6p6p3p4dl (output) ; 
var 

i : integer; 
procedure a(procedure b) ; 
begin 

writeC PASS'); 
b 
end; 
procedure c; 
begin 

writeC .') 
end; 
function d (procedure b) : integer; 
begin 
b; 

d;=2 
end? 

begin 

a(c); 

i:=d(c); 

if i=2 then 

writelnC .6.6,3.4-1') 
end. 
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{TEST 6.6.3.4-2, CLASS=CONFORMANCE} 

{ This program tests that the environment of procedure 
parameters is as stated in the Pascal Standard. 
The compiler fails if the program does not compile, or 
the program states that this is so. } 

program t6p6p3p4d2 (output) ; 
var 

globalone, global two : integer; 
procedure p(procedure f (procedure a ,b) /procedure g) ; 
var 

local top : integer; 
procedure r; 
begin 

if globalone=l then 
begin 

if ( global two<> 2) or ( local top<>l) then 
writelnC FAIL1. . .6.6.3.4-2 1 ) 
end 
else 

if global one=2 then 
begin 

if (global two<>2) or ( local top<>2} then 

writelnC FAIL2... 6.6.3. 4-2') 
else 

writelnC PASS. . .6.6.3.4-2' } 
end 
else 

writelnC* FAIL3. ..6.6.3.4-2'); 
globalone :=globalone+l; 
end; { of r } 

begin { of p } 

global two : =global two+1 ; 
local top : ^global two ; 
if global two=l then 

p(f,r) 
else 

f(g,r) 
end; { of p } 
procedure q(procedure f,g); 
begin 
f; 
g 

end; 
procedure dummy; 
begin 

writelnC FAIL4...6.6.3.4-2*) 
end; 

begin 

global one :=1; 

global two :=0; 

p(q, dummy) 
end. 
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(TEST 6.6.3.5-1, CLASS=CONFORMAMCE] 

{ Similarly to 6.6.3,4-1, this program tests that functions may 
be passed to procedures and functions as parameters. 
The compiler fails if the program does not compile and run. } 

program t6p6p3p5dl (output) ; 
var 

j : integer; 
procedure a(function b : integer); 
var 

i : integer; 
begin 
i:=b; 

write(« PASS') 
end; 
function c : integer; 
begin 

c:=2 
end} 
function d( function b : integer) : integer; 
begin 

end i 
begin 
a { c) ; 
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{TEST 6.6.3.5-2, CLASS=DEVTANCE} 
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{ This test checks functional compatibility in that function 
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types are required to be identical. The compiler deviates if the 
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program compiles and prints DEVIATES. } 
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program t6p6p3p5d2 (output) ; 
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type 


00431700 




natural=Q. .maxint; 
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var 
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k: integer; 
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function actual (i:natural) : natural; 
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begin 
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actual :=i 
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end; 
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procedure p(function formal (i:natural) : integer) ; 
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begin 
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k:=formal(10) 
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end; 
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begin 
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p( actual) ; 
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writelnC DEVIATES. . .6.6.3.5-2, FUNC TYPES NOT IDENTICAL 1 ) 
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{TEST 6.6.3.6-1, CLASS=DEVIANCE} 

{ This test checks that constants are not permitted 
as var parameters. The compiler deviates if the program 
compiles and prints DEVIATES. } 

program t6p6p3p6dl (output) ; 
const 

x=l; 
var 

y: integer; 
procedure assign(var p: integer); 
begin 

p:=100 
end; 

begin 

assign (y) ; 

assign(x); {disallowed} 

writelnC DEVIATES. . .6.6.3.6-1, VAR PARAMS') 
end. 



{TEST 6.6.3.6-2, CLASS=DEVIANCE} 

{ This test checks that parameter list compatibility is correctly 
implemented. The compiler deviates if the program compiles 
and prints DEVIATES. } 

program t6p6p3p6d2 (output) ; 
type 

natural = 0..maxint; 

procedure actual (i:integer; nrnatural); 
begin 

i:=n 
end; 

procedure p(procedure formal (a: integer; b: integer) ); 
var 

k,l: integer; 
begin 

k:=l; 1:=2; 

formal (k,l) 
end; 

begin 

p( actual); 

writelnC DEVIATES. . .6.6.3.6-2, VALUE PARS NOT IDENT TYPES') 
end. 
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{TEST 6.6.3.6-3, CLASS=DEVIANCE} 

{ This test checks that parameter list compatibility is correctly 
implemented. The compiler deviates if the program compiles 
and prints DEVIATES. } 

program t6p6p3p6d3 (output) ; 
type 

natural = 0..maxint; 

procedure actual (irinteger; nrnatural); 
begin 

i:=n 
end; 

procedure p(procedure formal (var a: integer; brnatural) ) ; 
var 

k,l:integer; 
begin 

k:=l; 1:=2; 

formal (k,l) 
end; 

begin 

p( actual) ; 

writelnC 5 DEVIATES. . .6.6.3.6-3, VALUE/VAR MISMATCH') 

end. 



(TEST 6.6,3.6-4, CLASS=DEVIANCE] 

{ This test checks that parameter list compatibility is correctly 
implemented. The compiler deviates if the program compiles 
and prints DEVIATES. } 

program t6p6p3p6d4 (output) ; 
type 

natural = Cmaxint; 

procedure actual(var i :integer;var nrnatural); 
begin 

i:=n 
end; 

procedure p( procedure formal (var a: integer; var b: integer)); 

var 

k,l:integer; 

begin 

k:=l; In- 
formal (k,l) 

end; 

begin 

p( actual) ; 

writelnC DEVIATES. . .6.6. 3.6-4, VAR PARS NOT IDENT TYPES') 
end. 
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{TEST 6.6.3.6-5, CLASS=DEVTANCE} 

{ This test checks that parameter list compatibility is correctly 
implemented. The compiler deviates if the program compiles 
and prints DEVIATES. } 

prog ram t6p6p3p6d5 (output) ; 
type 

natural = 0..maxint; 

procedure actual (i:integer; j: integer; n:natural); 
begin 

i:=n 
end; 

procedure p(procedure formal (a: integer; b: integer) ) ; 
var 

k,l: integer; 
begin 

k:=l; 1:=2; 

formal (k,l) 
end; 

begin 

p( actual) ; 

writelnC DEVIATES. ..6.6.3.6-5, NO OF PARS DIFFERENT') 
end. 



{TEST 6.6.4.1-1, CLASS=CONFORMANCE} 

{ This program tests that predefined standard procedures may 
be redefined with no conflict. 
The compiler fails if the program does not compile and run. } 

program t6p6p4pldl (output) ; 
var 

i : integer; 
procedure write(var a : integer); 

begin 
a:=a+2 

end; 
procedure get(var a : integer); 

begin 
a:=a*2 

end; 

begin 
i:=0; 
write(i) ; 
get(i); 
if i=4 then 

writelnC PASS. . .6.6.4. 1-1') 
else 

writelnC FAIL... 6. 6. 4. 1-1') 
end. 
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{TEST 



.5.2- 



CLASS=ERRORHANDLING } 



{ This program causes an error to occur, as eof(f) does 
not yield true prior to execution of a put on the file f. 
The error should be detected at compile-time or run-time. } 

program t6p6p5p2dl (output) ; 
var 

fyle : text; 
begin 

rewrite (fyle) ; 

writeln( fyle,' ABC); 

reset(fyle); { eof is false and fT='A* } 

put (fyle); { causes an error } 

writelnC ERROR NOT DETECTED. . .6.6.5. 2-1* ) 
end. 



{TEST 6.6.5.2-2, CLASS=ERRORHANDLING } 

{ This program causes an error to occur as eof(f) does 
not yield false prior to execution of a get on the file £. 
The error should be detected at compile-time or run-time. } 

program t6p6p5p2d2 (output) ; 
var 

fyle : texti 
begin 

rewrite (fyle) ; 

writelnC fyle/ ABC*); 

reset (fyle) ; 

get (fyle); { fyle?='A* } 

get (fyle); { fyle'MB' } 

get (fyle); { fyle?='C } 

get (fyle); { fyleT undefined... eof is true } 

get(fyle); { error since eof is true } 

writelnC ERROR NOT DETECTED. . .6.6.5.2-2') 
end. 



{TEST 6.6.5.2-3, CLASS=CONFORMANCE} 

{ This program tests if true is assigned to eof if the file f 
is empty when reset. } 

program t6p6p5p2d3 (output) ; 
var 

fyle : text; 
begin 

reset ( f yl e) ; 

if eof (fyle) then 

writelnC PASS. . .6.6.5.2-3') 

else 

writelnC FAIL. . .6.6.5.2-3') 
end. 
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{TEST 6.6.5.2-4, CIASS=CONFORMANCE} 

{ This program tests that the first element of a file f 
is assigned to the buffer variable fT when the procedure 
reset is used with the file f. } 

program t6p6p5p2d4 (output) ; 
var 

fyle : text; 
begin 

rewrite (fyle) ; 

wr iteln( fyle, 'ABC') ; 

writeln(fyle,'DEF') ; 

reset (fyle) ; 

if fyleT='A' then 

writelnC PASS. ..6.6.5. 2-4') 

else 

writelnC FAIL. . .6.6.5.2-4') 
end. 



{TEST 6.6.5.2-5, CLASS=CONF0RMANCE} 

{This program checks that a rewrite on the file f sets 
eof to be true. } 

program t6p6p5p2d5 (output) ; 
var 

fyle : text; 
begin 

rewrite (fyle) ; 

if eof (fyle) then 

writelnC PASS. ..6.6.5.2-5') 

else 

writelnC FAIL. . .6.6.5.2-5') 
end. 



00454300 
00454400 
00454500 
00454600 
00454700 
00454800 
00454900 
00455000 
00455100 
00455200 
00455300 
00455400 
00455500 
00455600 
00455700 
00455800 
00455900 
00456000 
00456100 



00456200 
00456300 
00456400 
00456500 
00456600 
00456700 
00456800 
00456900 
00457000 
00457100 
00457200 
00457300 
00457400 
00457500 
00457600 



{TEST 6.6.5.2-7, CLASS=ERRORHANDLING } 

{ This test is similar to 6.6.5.2-6, except that the 
buffer variable is an element of the record variable list 
of a with statement. 

The error should be detected by the compiler or at 
run-time. } 

program t6p6p5p2d7 (output) ; 
type 

sex = (mal e, female, no tgiven); 
soc ial sec urityn umber = 0.. 10000; 
rekord = record 

a : socialsecuritynumber; 
b : sex 
end; 
var 

fyle : file of rekord; 
begin 

rewrite (fyle) ; 
with fylef do 
begin 

a: =9999; 
b:=no tgiven* 
put ( f yl e) 
end; 

writelnC ERROR NOT DETECTED. . .6.6.5. 2-7* ) 
end, 
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{TEST 6.6.5.2-6, CLASS=ERRORHANDLING } 

{ This program causes an error to occur by changing the 
current file position of a file f , while the buffer 
variable is an actual parameter to a procedure. 
The error should be detected by the compiler, or at 
run-time. } 

program t6p6p5p2d6 (output) ; 
var 

fyle : text; 
procedure naughty(f : char); 

begin 

if f='G' then 
put (fyle) 

end; 
begin 

rewrite(fyle); 

fyleT:='G'; 

naughty(fyleT); 

writelnC ERROR NOT DETECTED. . .6.6.5.2-6') 
end. 



00457700 
00457800 
00457900 
00458000 
00458100 
00458200 
00458300 
00458400 
00458500 
00458600 
00458700 
00458800 
00458900 
00459000 
00459100 
00459200 
00459300 
00459400 
00459500 
00459600 
00459700 
00459800 






en 



{TEST 6.6.5.3-1, CLASS=CONFCRMANCE} 

{ This program checks that the procedure new has 
been implemented. Both forms of new are tested 
and both should pass. } 

program t6p6p5p3dl (output) ; 
type 



tWO 


= (a,b); 


recone 


= record 




i : integer; 




j : boolean 




end; 


rectwo 


= record 




c : integer; 




case tag field : two of 




a : (m : integer) ; 




b : (n : boolean) 




end; 


rec three 


= record 




c j integer; 




case tagfield : two of 




a : (case tagfeeld : two of 




a : (o : real); 




b : (p : char)); 




b : (q : integer) 




end; 


ptrone : 


T recone; 


ptrtwo : 


T rectwo; 


ptrthree 


: Tree three; 



var 

F 

F 

F 
begin 

new (ptrone) ; 

new(ptrtwo,a) ; 

ptrtwo?. tag fi eld :=a; 

new( ptrthree, a ,b) ; 

ptrthree?. tagfi eld :=a; 

ptrthree? .tagfeeld:=a; 

writelnC PASS. . .6.6.5.3-1') 
END. 
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(TEST ">,6,5,3~2, CLASS=C0NF0RMANCE} 

{ This program tests that new and dispose operate as described 
in the Standard, however the undefinition of the pointer 
variable by dispose is not tested. 
The compiler fails if the program does not compile 
and run to completion. } 

program t6p6p5p3d2 (output) ; 
var 

ptr : T integer; 
i : integer; 
beg in 

for i:=! to 10 do 
begin 

new(ptr) ; 
ptr?:=i; 
dispose (ptr) 
end} 

writelnC PASS. . .6.6.5. 3-2') 
end. 



{TEST 6.6.5.3-3, CLASS=ERRORHANDLING} 

{ This program causes an error to occur as the pointer- 
parameter of dispose is nil. The error should be detected 
by the compiler or at run-time. } 

program t6p6p5p3d3 (output) ; 
type 

rekord = record 

a : integer; 
b : boolean 
end; 
var 

ptr : ? rekord; 
begin 

ptr :=nil; 
dispose (ptr) ; 

writelnC ERROR NOT DETECTED. . .6.6.5.3-3') 
end. 



00466700 D> 
0046680000 

00466900 Q 

00467000 ji- 

00467100 

00467200^ 

00467300 g 

00467400 00 

00467500^ 

00467600 j-» 

00467700 <=^ 

00467800 

00467900 

00468000 

00468100 

00468200 

00468300 

00468400 

00468500 

00468600 

00468700 



0046880C 

00468900 

00469000 

00469100 

00469200 o 

00469300 O 

00469400 ^ 

00469500 U3 

00469600 m 

00469700 J° 

00469800 

00469900 

00470000 

00470100 <X> 

00470200 

00470300 

00470400 

00470500 

00470600 






CD 






{TEST 6.6.5.3-4, CLASS=ERRORHANDLING } 

{ Similarly to 6.6.5.3-3, an error is caused bv t*<* 
pointer variable of dispose be*^ 

The error should be <*-" ' '" - compiler 

or at r—- " * . 

Jt wuu t6p6p5p3d4 (output) ; 
type 

rekord = record 

a : integer; 
b : boolean 
end; 
var 

ptr : T rekord; 
begin 

dispose (ptr) ; 

writelnC ERROR NOT DETECTED. . .6.6.5.3-4 ') 
end. 



{TEST 6.6.5.3-5, CIASS=ERRORHANDLING } 

{ This program causes an error to occur as a variable 
which is currently an actual variable parameter is 
refered to by the pointer parameter of dispose. 
The error should be detected by the compiler or 
at run-time. } 

program t6p6p5p3d5 (output) ; 
var 

ptr : T integer; 
pr oced ur e er ro r ( a : i nteg er ) ; 

var 

x : integer; 

begin 

x:=a*2; 
dispose (ptr) 

end; 
begin 

new (ptr) ; 

ptrt:=6; 

error (ptrT); 

writelnC ERROR NOT DETECTED. . .6.6.5.3-5') 
end. 



00470700 
00470800 
00470900 
00471000 
00471100 
00471200 
00471300 
00471400 
00471500 
00471600 
00471700 
00471800 
00471900 
00472000 
00472100 
00472200 
00472300 
00472400 
00472500 



00472600 
00472700 
00472800 
00472900 
00473000 
00473100 
00473200 
00473300 
00473400 
00473500 
00473600 
00473700 
00473800 
00473900 
00474000 
00474100 
00474200 
00474300 
00474400 
00474500 
00474600 
00474700 
00474800 
00474900 



{TEST 6.6.5.3-6, CLASS=ERRORHANDLING } 

{ This program causes an error to occur as a variable which 
is an element of the record-variable-list of a with 
statement is refered to by the pointer parameter of 
dispose. } 

program t6p6p5p3dS (output) ; 
type 

subrange = 0..9999; 
rekord = record 

name : packed array[1..15] of char; 
employeeno : subrange 
end; 
var 

ptr : T rekord; 
begin 

new (ptr) ; 
with ptr? do 
begin 

name: =' HARRY M. MULLER'; 
employeeno : =9998; 
dispose (ptr) 
end* 

writelnC ERROR NOT DETECTED. . .6.6,5.3-6'} 
end. 



{TEST 6.6,5.3-7, CLASS=ERRORHANDLING } 

{ This program causes an error to occur, as a variable 
created by the use of the variant form of new is used 
as an operand in an expression. 

The error should be detected by the compiler, or at 
run-time. } 

program t6p6p5p3d7 (output) ; 
type 



two 


= (a,b); 


rekord 


= record 




case tagfield:two of 




a : (m : boolean) ; 




b : (n : char) 




end; 


var 




ptr 


: T rekord; 


r 


: rekord; 


begin 




new (ptr, 


,a); 


ptrT.m:= 


=true; 


r:=ptrT; 




writelni 


[» ERROR NOT DETECT- U.. 6. 


end. 
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{TEST 6.6.5.3-8, CLASS=ERRORHANDLING } 

{ This test is similar to 6.6.5.3-7, except that the 
variable created is used as the variable in an assignment 
statement . 

The error should be detected by the compiler or at 
run- time. } 

program t6p6p5p3d8 (output) ; 
type 

tv*D = (a,b); 
rekord = record 

case tagfieldrtwo of 
a : (m : boolean) ; 
b : (n : char) 
end; 
var 

ptr : T rekord; 
r : rekord; 
begin 

new(ptr,b); 
r.tagfield:=b; 
r.n:='A»; 
ptr?:=r; 

writeln(» ERROR NOT DETECTED. . .6.6.5.3-8') 
end. 



{TEST 6.6.5.3-9, CLASS=ERRORHANDLING } 

{ This test is similar to 6.6.5.3-7, except that the 
variable created is used as an actual parameter. 
The error should be detected by the compiler or at 
run-time. } 

program t6p6p5p3d9 (output) ; 
type 

two = (a,b); 
rekord = record 

case tagfield:two of 
a : (m : boolean) ; 
b : (n : char) 
end; 
var 

ptr : T rekord; 
procedure error (c : rekord); 
begin 

writeln(* ERROR NOT DETECTED. . .6. 6. 5.3-9* ) 
end; 
begin 

new(ptr,a) ; 
ptrT.m:=true; 
error ( ptr T) 
end. 
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{TEST 6.6.5.4-1, CLASS=CONFORMANCE} 

{ This program tests that pack and unpack are 
implemented in this compiler as according to the 
Standard . 
The compiler fails if the program does not compile. } 

program t6p6p5p4dl (output) ; 
type 

colourtype = ( red, pink, or ange,yellow,green, blue) ; 
var 

unone : array [3.. 24] of char; 

pacone : packed array[1..4] of char; 

untwo : array[4..8] of colourtype; 

pactwo : packed array[6..7] of colourtype; 

i : integer; 

colour : colourtype; 
begin 

pacone :='ABCD'; 

unpack (pacone , unone, 5) ; 

colour := red; 

for i:=4 to 8 do 

begin 

untwo [ i] : =colour ; 
colour :=succ( colour) 

end; 

pack (untwo, 5, pactwo) ; 

if unone[5]= , A l then 

writelnC PASS. . .6.6.5.4-1') 

else 

writeln(« FAIL. . .6.6.5. 4-1') 
end. 
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{TEST 6.6.6.1-1, CIASS=IMPLEMENTATIONDEPENDENT} 00488500 

00488600 

{ The Pascal Standard does not state what action takes place 00488700 

when a standard function is used as a functional 00488800 

parameter. The effect is implementation dependent. 00488900 

This program uses a standard function as a parameter to a 00489000 

procedure. The compiler may reject this as an error, or 00489100 

may permit it as it should other functional parameters. } 00489200 

00489300 

program t6p6p6pldl (output) ; 00489400 

procedure quidnunk( function a(b : integer) : boolean) ; 00489500 

var 00489600 

x : integer; 00489700 

y : boolean; 00489800 

begin 00489900 

x:= 5; 00490000 

y:=a(x); 00490100 

if x=l then 00490200 

writelnC STANDARD FUNCTIONS PERMITTED AS PARAMETERS', 00490300 

'...6. 6. 6. 1-1 •) 00490400 

else 00490500 

writeln(' STANDARD FUNCTIONS NOT PERMITTED AS ', 00490600 

•PARAMETERS. ..6.6.6. 1-1') 00490700 

end; 00490800 

begin 00490900 

quidnunk(odd) 00491000 

end. 00491100 



{TEST 6.6.6.2-1, CLASS=CONFORMANCE} 

{ This program tests the implementation of the arithmetic 
function abs. Both real and integer expressions are used. 
The compiler fails if the program does not compile and run. } 

program t6p6p6p2dl (output) ; 
const 

pi = 3.1415926; 
var 

i, counter : integer; 
r : real; 
function myabsl (i : integer) : integer; 
begin 

if i<0 then 

myabsl :=-i 
else 

myabsl :=i 
end; 
function myabs2(r:real) :real; 
begin 

if r<0 then 

myabs2:=-r 
else 

myabs2:=r 
end; 
begin 

counter :=0; 

for i:=-10 to 10 do 

begin 

if abs(i)=myabsl(i) then 
counter : =counter+l 
end; 

r:=-10.3; 
while r<10.3 do 
begin 

if abs(r)--myabs2(r) then 
counter :=counter+l; 

r:=r+0.9 
end ; 

if counter=44 then 

writelnC PASS. . .6. 6. 6.2-1') 
else 

writelnC FAIL. . .6. 6. 6. 2-1: ABS') 
end. 
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{TEST 6.6.6.2-2, CLASS=CONFORMANCE} 

{ This program tests the implementation of the arithmetic 
function sqr. Both real and integer expressions are used. 
The compiler fails if the program does not compile and run. 

program t6p6p6p2d2 (output) ; 
var 

i, counter : integer; 
variable : real; 
begin 

counter := 0; 

for i:= -10 to 10 do 

begin 

if sqr(i) = i*i then 

counter := counter + 1; 
end; 

variable := -10.3; 
while (variable < 10.3) do 
begin 

if (sqr (variable) = variable*variable) then 

counter := counter+1; 
variable := variable + 0.9; 
end; 
if (counter = 44) then 

writelnC PASS. . .6.6.6.2-2') 
else 

writelnC FAIL. . .6.6.6. 2-2:SQR') 
end. 
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{TEST 6,6.6.2-3, CLASS=CONFORMANCE} 

{ This program tests the implementation of the arithmetic 
functions sin, cos, exp, In, sqrt, and arctan. 
A rough accuracy test is done, but is not the purpose 
of this program. 
The compiler fails if the program does not compile and run. } 

program t6p6p6p2d3 (output) ; 
const 

pi = 3.1415926; 
var 

counter : integer; 
begin 

counter :=0; 

if (sin(pi)<0. 000001) and 

((0.70710<sin(pi/4)) and (sin ( pi/4 )<0. 70711 ) ) then 
counter :=counter+l 
else 

writelnC FAIL. . .6.6.6.2-3 : SIN'); 

if ( cos ( pi )<-0. 99999) and 

((0.70710<cos(pi/4)) and (oos(pi/4)<0. 70711)) then 

counter :=counter+l 
else 

writelnC FAIL. . .6.6.6.2-3 : COS'); 

if ((2.71828<exp(l)) and (exp(l)<2. 71829) ) and 
((0. 36787 <exp(-l)) and (exp(-l)<0. 36788)) and 
((8103.08392<exp(9)) and (exp(9) <8103. 08393) ) then 
counter : =counter+l 

else 

writelnC FAIL. . .6.6.6.2-3 : EXP»); 

if (ln(exp(l))>0. 99999) and 

((0.69314<ln(2)) and (ln(2)<0. 69315)) then 

counter : =counter+l 
else 

writelnC FAIL.. .6.6.6.2-3 : LN'); 

if (sqrt(25)=5) and 

((5.09901<sqrt(26)) and (sqrt(26)<5. 09902)) then 

counter : =counter+l 
else 

writelnC FAIL.. .6.6.6.2-3 : SQRT»); 

if ((0.09966<arctan(0.1)) and (arctan(0. 1)<0. 09967 ) ) and 

(arctan(0)=0) then 

counter :=counter+l 
else 

writelnC FAII 6.6.6.2-3 : ARCTAN 1 ); 

if counter=6 then 

writelnC PASS. . .6.6.6.2-3') 
end. 
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{TEST 6.6.6.2-4, CLASS=ERRORHANDLING } 

{ This program causes an error to occur as an expression 
with a negative value is used as an argument for the 
arithmetic function In. 
The error should be detected at run-time. } 

program t6p6p6p2d4 (output) ; 
var 

m : real; 
begin 

m:=*-2. 71828; 

m:=ln(m*2); 

writelnC ERROR NOT DETECTED. . .6.6.6.2-4') 
end. 



{TEST 6.6.6.2-5, CLASS=ERRORHANDLING } 

{ This program causes an error to occur as a negative 
argument is used for the sqrt function. 
The error should be detected at run-time. } 

program t6p6p6p2d5 (output) ; 
var 

m : real; 

i, j : integer; 
begin 

i:=256; 

j:=i*2; 

J:=J-257; 

m:=sqrt(j-i); 

writelnC ERROR NOT DETECTED. . .6.6.6.2-5') 
end. 
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{TEST 6.6.6.2-6, CLASS=QUALITY} 

{ This test checks the implementation of the sqrt function. } 

program t6p6p6p2d6 (output) ; 

var 



{ 



data required 

none 

other subprograms in this package 

machar - An environmental inquiry program providing 

information on the floating-point arithmetic 
system. Note that the call to machar can 
be deleted provided the following five 
parameters are assigned the values indicated 

ibeta - the radix of the floating-point system 

it the number of the base- ibeta digits in the 

significand of a floating-point number 
eps the smallest positive floating-point 

number such that 1.0+eps <> 1.0 
xmin - the smallest positive floating-point 

number 
xmax - the largest finite floating-point no. 

randl(x) - A function subprogram returning logarithmically 
distributed random real numbers. In particular, 

a * randl(ln(b/a)) 
is logarithmically distributed over (a,b) 

random - A function subprogram returning random real 
numbers uniformly distributed over (0,1) 



standard subprograms required 

abs, In, exp, sqrt 

} 

i , ibeta , iexp , irnd , it , j , k , kl , machep , max exp , 
iy,minexp , n , negep , ngrd : integer ; 

a , albeta , b , beta , c , eps , epsneg , r5 , r6 , r7 , sqbeta , w 
, x , xmax , xmin , xn , xl , y , z : real ; 
procedure machar (var ibeta , it , irnd , ngrd , machep , negep , iexp, 
minexp , maxexp : integer ; var eps , epsneg , xmin , xmax : real ) ; 



This subroutine is intended to determine the characteristics 
of the floating-point arithmetic system that are specified 
below. The first three are determined according to an 
algorithm due to M. Malcolm, CACM 15 (1972), pp. 949-951, 
incorporating some, but not all, of the improvements 
suggested by M. Gentleman and S. Marovich, CACM 17 (1974) , 
pp. 276-277. The version given here is for single precision. 
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ibeta is the radix of the floating-point representation 

it is the number of base ibeta digits in the floating-point 

significand 
irnd = if the arithmetic chops, 

1 if the arithmetic rounds 
ngrd = if irnd=l, or if irnd=0 and only it base ibeta 

digits participate in the post normalization shift 
of the floating-point significand in multiplication 

1 if irnd=0 and more than it base ibeta digits 
participate in the post normalization shift of the 
floating-point significand in multiplication 
machep is the exponent on the smallest positive floating-point 

number eps such that 1.0+eps <> 1.0 
negeps is the exponent on the smallest positive fl. pt. no. 

negeps such that 1.0-negeps <> 1.0, except that 

negeps is bounded below by it-3 
iexp is the number of bits (decimal places if ibeta = 10) 

reserved for the representation of the exponent of 

a floating-point number 
minexp is the exponent of the smallest positive fl. pt. no. 

xmin 
maxexp is the exponent of the largest finite floating-point 

number xmax 
eps is the smallest positive floating-point number such 

that 1.0+eps <> 1.0. in particular, 

eps = ibeta**machep 
epsneg is the smallest positive floating-point number such 

that 1.0-eps <> 1.0 (except that the exponent 

negeps is bounded below by it-3). in particular 

epsneg = ibeta**negep 
xmin is the smallest positive floating-point number, in 

particular, xmin = ibeta ** minexp 
xmax is the largest finite floating-point number, in 

particular xmax = (1.0-epsneg) * ibeta ** maxexp 

note - on some machines xmax will be only the 

second, or perhaps third, largest number, being 

too small by 1 or 2 units in the last digit of 

the significand. 



} 



i , iz , j , k , mx : integer ; 

a , b , beta , betain , betaml , one , y , z , zero : real ; 

under flo : boolean; 

begin 

irnd := 1 ; 
one := ( irnd ) ; 
a := one + one ; 
b := a ; 
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zero := 0.0 ; 

determine ibeta, beta ala Malcolm 

while ( ( ( a + one ) - a ) - one = zero ) do begin 

a := a + a ; 
end ; 
while ( ( a + b ) - a = zero ) do begin 

b := b + b ; 
end ; 

ibeta := trunc ( ( a + b ) - a ); 
beta := ( ibeta ) ; 
betaml := beta - one ; 

determine irnd, ngrd, it 

if ( ( a + betaml ) - a = zero ) then irnd := ; 
it := ; 
a := one ; 
repeat begin 

it := it + 1 ; 

a := a * beta ; 
end until ( ( ( a + one ) - a ) 

determine negep, epsneg 

negep := it + 3 ; 
a := one ; 

for i := 1 to negep do begin 

a i= a / beta ; 
end ; 

while ( ( one - a ) - one = zero ) do begin 



one <> zero ) ? 



a 



a * beta ; 



negep : = negep - 1 ; 
end ; 

negep := - negep ; 
epsneg := a ; 

determine machep, eps 

machep := negep ; 

while ( ( one + a ) - one = zero ) do begin 

a := a * beta ; 

machep := machep + 1 ; 
end ; 
eps := a ; 

determine ngrd 

ngrd : = ; 

if(( irnd =0) and((( one + eps) * one - one) <> zero)) then 

ngrd : = 1 ; 

determine iexp, minexp, xmin 

loop to determine largest i such that 

(1/beta) ** (2**(i)) 
does not underflow 
exit from loop is signall by an underflow 
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i := ; 

beta in := one /beta ; 

z := betain ; 

underflo := false; 
repeat begin 

y := z ; 

z := y * y ; 

check for underflow 

if ( ( z * one = zero ) or ( abs ( z )> y ) ) then begin 

underflo := true; 
end else begin 
i := i + 1 ; 
end; 
end until underflo ; 
k := 1 ; 

determine k such that (l/beta)**k does not underflow 

first set k = 2 ** i 



for j := 1 to i do begin 

k := k + k ; 
end ; 

iexp := i + 1 ; 
mx := k + k ; 

if ( ibeta = 10 ) then begin 
{ 

for decimal machines only 

iexp := 2 ; 

iz := ibeta ; 

while ( k >= iz ) do begin 
iz := iz * ibeta ; 
iexp := iexp + 1 ; 

end ; 

mx := iz + iz - 1 ; 
end; 

underflo := false; 
repeat begin 

loop to construct xmin 

exit from loop is signalled by an underflow 

xmin := y ; 

y := y * betain ; 

if ( ( ( y * one ) = zero ) or ( abs ( y )> xmin ) ) 

then begin 

underflo := true; 
end else begin 
k := k + 1 ; 
end; 
end until underflo ; 
minexp := - k ; 
{ determine maxexp, xmax 

if ( ( mx <= k + k - 3 ) and ( ibeta <> 10 ) ) then begin 
mx := mx + mx ; 
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iexp := iexp + 1 ; 
end; 

maxexp := mx + minexp ; 
adjust for machines with implicit leading 
bit in binary significand and machines with 
radix point at extreme right of significand 

i := maxexp + minexp ; 

if ( ( ibeta = 2 ) and ( i = ) ) then maxexp := maxexp - 1 

if ( i > 20 ) then maxexp := maxexp - 3 ; 

xmax := one - epsneg ; 

if ( xmax * one <> xmax ) then xmax := one - beta * epsneg ; 

xmax := ( xmax * betain * betain * betain ) / xmin ; 

i := maxexp + minexp + 3 ; 

if ( i > ) then begin 

for j := 1 to i do begin 
xmax := xmax * beta ; 
end ; 
end; 



end; 



function random : real ; 

{ random number generator - based on algorithm 266 
by Pike and Hill (modified by Hansson) 
collected Alg. from CACM. 

This subprogram is intended for use on computers with 
fixed point wordlength of at least 29 bits, it is 
best if the floating point significand has at most 
29 bits. } 

{ The quality of the random numbers is not important. 

If recoding is needed for small wordlength computers, 
even returning a constant value or zero is possible. } 



{ 



The value iy is global, and is initialized in the driver } 



begin 

iy := (iy*125) mod 2796203; 

random : = ( iy )/ 2796203. OeO ; 
end; 



function randl (x : real ) : real ; 

{ returns pseudo random n>inbers logarithmically distributed 

over (l,exp(x)). thus ci*t^ndl (ln(b/a) ) is logarithmically 
distributed in (a,b) . 

other subroutines required 

exp(x) - the exponential routine 

random - ^ function program returning random real 
numbers uniformly distributed over (0,1). 
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begin 

randl 
end; 



exp ( x * random ) ; 



procedure printtestrun (n: integer; lb,ub:real; 

big, small : integer; 

mean ,maxer ror ,xmaxer ror , rmserror : real ) ; 
begin 

writelnC ':5,n:4,' RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL*) 

writelnC • :10, • (' ,lb:15, ' , ' ,ub:15, ') ') ; 

writeln; 

writelnC ':5,'THE RESULT WAS TOO LARGE' , big: 5, ' TIMES, AND'); 

writelnC ':10,'TOO SMALL' , small :5,' TIMES'); 

writeln; 

if (mean <> 0.0) then begin 

writelnC ':5,'MEAN RELATIVE ERROR = ' ,mean:15, '=' f 
IBETA:4,' ** * f LN(ABS (mean) )/ALBETA: 7:2) ; 
end; 
if (maxerrorO 0.0) then begin 

writelnC ':5,'THE MAXIMUM RELATIVE ERROR OF 1 ,maxerror :15, '=' , 
IBETA:4,' ** ' ,LN(ABS(maxerror) ) /ALBETA:7:2) ; 

writelnC ': 10 ,» OCCURRED FOR X = • ,xmaxerror:15) ; 
end; 
if (rmserror <> 0.0) then begin 

writelnC ': 5, 'ROOT-MEAN-SQUARE RELATIVE ERROR =» ,rmserror:15, 
•=',IBETA:4,' ** ' ,LN(ABS( rmserror) )/ALBETA: 7:2) ; 
end; 

writeln; 
end; { OF PRINT TEST RUN } 

begin 

machar ( ibeta , it , irnd , ngrd , machep , negep , iexp , minexp , 

maxexp , eps , epsneg , xmin , xmax ) ; 
beta := ( ibeta ) ; 
sqbeta := sqrt ( beta ); 
albeta := In ( beta ) ; 
a := 1.0 / sqbeta ; 
b := 1.0 ; 
n := 2000 ; 
iy := 100001; 
{ 

random argument accuracy tests 

for j := 1 to 2 do begin 
c := In ( b / a ); 
k := ; 
kl := ; 
xl := 0.0 
r5 := 0.0 
r6 := 0.0 
r7 := 0.0 

for i := 1 to n do begin 
x := a * randl ( c ) ; 
y := x * x ; 
z := sqrt ( y ); 
w := ( z - x ) / x ; 
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if ( w > 0.0 ) then k := k + 1 ; 

if ( w < 0.0 ) then kl := kl + 1 ; 

r5 := r5 + w ; 

w : = abs ( w ) ; 

if ( w > r6 ) then begin 

r6 := w ; 

xl := x ; 
end; 

r7 := r7 + w * w ; 
end ; 

xn := ( n ) ; 
r5 := r5 / xn ; 
r7 := sqrt ( r7 / xn ) ; 
writelnC TEST OF SQRT(X*X) - X'); 
writeln; 

printtestrun (n,a,b,k,kl,r5,r6,xl,r7); 
a := 1.0 ; 
b := sqbeta ; 
end ; 

special tests 

writelnC TEST OF SPECIAL ARGUMENTS'); 

writeln; 

x := xmin ; 

y := sqrt ( x ); 

writelnC SQRT(XMIN) = SQRT(* ,x:15, * ) = ',y:15); 

writeln; 

x := 1.0 - epsneg ; 

y := sqrt ( x ); 

writelnC SQRT (1 -EPSNEG) = SQRT(l-' f epsneg: 15, ') = ',y:15); 

writeln; 

x := 1.0 ; 

y := sqrt ( x ); 

writelnC SORT(l.O) =SQRT(', x:15, ') = ', y:15); 

writeln; 

x := 1.0 + eps ; 

y := sqrt ( x ); 

writelnC SQRT(1+EPS) = SQRT(l+» ,eps:15, ') = ', y:15); 

writeln; 

x := xmax ; 

y := sqrt ( x ); 

writelnC SORT (XMAX) - SQRT(', x:15, ') = ', y:15); 

writeln; 

x := 0.0 ; 

y := sqrt ( x ); 

writelnC SQRT(O.O) - SQRTC ,x:15,' ) = ', y:15); 

writeln; 

No tests for error conditions are made here. 

Test 6.6.6.2-5 calls sqrt with a negative argument. 



writelnC THIS CONCLUDES THE TESTS'); 
end. 



GO 
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{TEST 6.6.6.2-7, CLASS=QUALITY} 

{ This test checks the implementation of the function arctan. } 

program t6p6p6p2d7 (output) ; 

var 

{ data required 

none 

subprograms required from this package 

machar - as for sqrtest 
random - as for sqrtest 

standard subprograms required 

abs, In, arctan, sqrt } 

i , ibeta , iexp , irnd , ii , it , il , j , k , kl , machep , 
iy , maxexp , minexp , n , negep , ngrd : integer ; 
a , albeta , b , beta , betap , del , em , eps , epsneg , expon , 
half , ob32 , one , r5 , r6 , r7 , sum , w , x , xl , xmax , xmin , 
xn , xsq , xl , y , z , zero , zz : real ; 

procedure machar (var ibeta , it , irnd , ngrd , machep , negep , iexp, 
minexp , maxexp : integer ; var eps , epsneg , xmin , xmax : real ) ; 



This subroutine is intended to determine the characteristics 
of the floating-point arithmetic system that are specified 
below. The first three are determined according to an 
algorithm due to M. Malcolm, CACM 15 (1972), pp. 949-951, 
incorporating some, but not all, of the improvements 
suggested by M. Gentleman and S. Marovich, CACM 17 (1974) , 
pp. 276-277. The version given here is for single precision. 



Latest revision - October 1, 1976. 

Author - W. J. Cody 

Argonne National Laboratory 



Revised for Pascal 



ibeta 
it 



irnd 



ngrd 



R. A. Freak 
University of Tasmania 
Hobart 
Tasmania 



is the radix of the floating-point representation 

is the number of base ibeta digits in the floating-point 

significand 
= if the arithmetic chops, 
1 if the arithmetic rounds 
= if irnd=l, or if irnd=0 and only it base ibeta 
digits participate in the post normalization shift 
of the floating-point significand in multiplication 
1 if irnd=0 and more than it base ibeta digits 
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participate in the post normalization shift of the 
floating-point significand in multiplication 
machep is the exponent on the smallest positive floating-point 

number eps such that 1.0+eps <> 1.0 
negeps is the exponent on the smallest positive fl. pt. no. 

negeps such that 1.0-negeps <> 1.0, except that 

negeps is bounded below by it-3 
iexp is the number of bits (decimal places if ibeta = 10) 

reserved for the representation of the exponent of 

a floating-point number 
minexp is the exponent of the smallest positive fl. pt. no. 

xmin 
maxexp is the exponent of the largest finite floating-point 

number xmax 
eps is the smallest positive floating-point number such 

that 1.0+eps <> 1.0. in particular, 

eps = ibeta* *machep 
epsneg is the smallest positive floating-point number such 

that 1.0-eps <> 1.0 (except that the exponent 

negeps is bounded below by it-3). in particular 

epsneg = ibeta**negep 
xmin is the smallest positive floating-point number, in 

particular, xmin = ibeta ** minexp 
xmax is the largest finite floating-point number, in 

particular xmax = (1.0-epsneg) * ibeta ** maxexp 

note - on some machines xmax will be only the 

second, or perhaps third, largest number, being 

too small by 1 or 2 units in the last digit of 

the significand. 



} 



i , iz , j , k , mx : integer ; 

a , b , beta , betain , betaml , one , y , z , zero : real ; 

underflo : boolean; 

begin 

irnd := 1 ; 
one := ( irnd ); 
a := one + one ; 
b := a ; 
zero := 0.0 ; 



{ 



determine ibeta, beta ala Malcolm 

while ( ( ( a + one ) - a ) - one = zero ) do begin 

a := a + a ; 
end ; 
while ( ( a + b ) - a = zero ) do begin 

b := b + b ; 
end ; 

ibeta := trunc ( ( a + b ) - a ); 
beta := ( ibeta ) ; 
betaml := beta - one ; 

determine irnd, ngrd, it 

if ( ( a + betaml ) - a = zero ) then irnd := ; 
it :- ; 
a := one ; 
repeat begin 
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it := it + 1 ; 
a := a * beta ; 
end until ( ( ( a + one ) - a ) - one <> zero ) ; 

determine 'negep, epsneg 

negep := it + 3 ; 
a := one ; 

for i := 1 to negep do begin 

a := a / beta ; 
end ; 

while ( ( one - a ) - one = zero ) do begin 

a := a * beta ; 

negep := negep - 1 ; 
end ; 

negep := - negep ; 
epsneg := a ; 

determine machep, eps 

machep := negep ; 

while ( ( one + a ) - one = zero ) do begin 

a := a * beta ; 

machep := machep + 1 ; 
end ; 
eps := a ; 

determine ngrd 

ngrd := ; 

if(( irnd =0) and((( one + eps) * one - one) <> zero)) then 

ngrd := 1 ; 

determine iexp r minexp, xmin 

loop to determine largest i such that 

(1/beta) ** (2**(i)) 
does not underflow 
exit from loop is signal 1 by an underflow 

i := ; 

betain := one / beta ; 

z := betain ; 

under flo := false; 

repeat begin 

y :* z ; 

z := y * y ; 

check for underflow 

if ( ( z * one = zero ) or ( abs ( z )> y ) ) then begin 

under flo := true; 
end else begin 
i := i + 1 ; 
end; 
end until underflo ; 
k := 1 ; 

determine k such that (1/beta) **k does not underflow 
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first set k = 2 ** i 



for j := 1 to i do begin 

k := k + k ; 
end ; 

iexp := i + 1 ; 
mx := k + k ; 

if { ibeta = 10 ) then begin 
{ 

for decimal machines only 
iexp := 2 ; 
iz := ibeta ; 

while ( k >= iz ) do begin 
iz := iz * ibeta ; 
iexp := iexp + 1 ; 
end ; 

mx := iz + iz - 1 ; 
end; 

underflo := false; 
repeat begin 
{ 

loop to construct xmin 

exit from loop is signalled by an underflow 

xmin := y ; 

y := y * betain ; 

if ( ( ( y * one ) = zero ) or ( abs ( y )> xmin ) ) 

then begin 

underflo := true; 
end else begin 
k := k + 1 ; 
end; 
end until underflo ; 
minexp := - k ; 
{ determine maxexp, xmax 

if ( ( mx <= k + k - 3 ) and ( ibeta <> 10 ) ) then begin 
mx := mx + mx ; 
iexp := iexp + 1 ; 
end; 

maxexp := mx + minexp ; 
{ adjust for machines with implicit leading 
bit in binary significand and machines with 
radix point at extreme right of significand 

i := maxexp + minexp ; 

if ( ( ibeta = 2 ) and ( i = ) ) then maxexp := maxexp - 1 ; 

if ( i > 20 ) then maxexp := maxexp - 3 ; 

xmax := one - epsneg ; 

if ( xmax * one <> xmax ) then xmax := one - beta * epsneg ; 

xmax := ( xmax * betain * betain * betain ) / xmin ; 

i := maxexp + minexp + 3 ; 

if ( i > ) then begin 

for j := 1 to i do begin 
xmax := xmax * beta ; 
end ; 
end; 
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end; 



function random : real ; 

{ random number generator - based on algorithm 266 
by Pike and Hill (modified by Hansson) 
collected Alg. from CACM. 

This subprogram is intended for use on computers with 
fixed point wordlength of at least 29 bits, it is 
best if the floating point significand has at most 
29 bits. } 

{ The quality of the random numbers is not important. 

If receding is needed for small wordlength computers, 
even returning a constant value or zero is possible. } 



{ 



The value iy is global, and is initialized in the driver } 



begin 

iy := (iy*125) mod 2796203; 

random : = ( iy )/ 2796203. OeO ; 
end; 



procedure printtestrun (n: integer; lb,ub:real; 

big, small : integer; 

mean ,maxer ror ,xmaxer ror , rmser ror : real) ; 
begin 

writelnC , :5,n:4,' RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL' 

writelnC MO,' (' ,lb:15,' ,' ,ub:15,') ») ; 

writeln; 

writelnC '^'THE RESULT WAS TOO LARGE 1 , big: 5, ' TIMES, AND'); 

writelnC ':10,*TOO SMALL* , small: 5, ' TIMES'); 

writeln; 

if (mean <> 0.0) then begin 

writelnC ':5,'MEAN RELATIVE ERROR =' ,mean:15, '=' , 
IBETA:4,' ** ' ,lN(ABS(mean) )/ALBETA:7: 2) ; 
end; 
if (maxerrorO 0.0) then begin 

writelnC '^'THE MAXIMUM RELATIVE ERROR OF' ,maxerror :15, '=• , 
IBETA:4,' ** ' ,UN(ABS (max error) )/ALBETA:7:2) ; 

writelnC ': 10 ,' OCCURRED FOR X = ' ,xmaxerror:15) ; 
end; 
if (rmser ror <> 0.0) then begin 

wr i tel n (' ' : 5 , ' ROOT-MEAN-SQUARE RELATIVE ERROR = ' , rmser ro r : 1 5 , 
^SIBETA^,' ** ' ,LN(ABS(rmserror))/ALBETA:7:2); 
end; 

writeln; 
end; { OF PRINT TEST RUN } 



begin 

iy := 100001; 

machar ( ibeta , it , irnd , ngrd , machep , negep , iexp , minexp 

maxexp , eps , epsneg , xmin , xmax ) ; 
beta : = ( ibeta ) ; 
albeta := In ( beta ); 
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one := 1.0 ; 
half := 0.5 ; 
zero := 0.0 ; 
a := - 0.0625 ; 
b := - a ; 
ob32 := b * half ; 
n := 2000 ; 
xn : = ( n ); 
il := ; 

random argument accuracy tests 

for j := 1 to 4 do begin 
k := ; 
kl := ; 
xl := zero ; 
r5 := zero ; 
r6 := zero ; 
r7 := zero ; 
del := ( b - a ) / xn ; 
xl := a ; 

for i := 1 to n do begin 
x := del * random + xl ; 

if ( j = 2 ) then x := ( ( 1.0 + x * a ) - one ) * 16.0 
z := arctan ( x ) ; 
case j of 
1: 

begin 

xsq := x * x ; 

em := 17.0 ; 

sum := xsq / em ; 

for ii := 1 to 7 do begin 

em := em - 2.0 ; 

sum := ( one /em - sum 
end ; 



xsq 



2: 



zz 

end; 



:= x - x * sum ; 



begin 

y := x - 0.0625 ; 

y := y / ( one + x * a ) ; 

zz := ( arctan ( y )- 8. 1190004042651 526021e-5 ) + 

ob32 ; 
zz := zz + ob32 ; 
end; 
3,4: 

begin 

z := z + z ; 

y := x / ( ( half + x * half ) * ( ( half - x ) + half ) 

) ; 
zz := arctan ( y ) ; 
end; 
end; 

w := ( z - zz ) / z ; 
if ( w > zero ) then k := k + 1 ; 
if ( w < zero ) then kl := kl + 1 ; 
r5 := r5 + w ; 
w : = abs ( w ) ; 
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if ( w > r6 ) then begin 

r6 := w ; 

xl := x ; 
end; 

r7 := r7 + w * w ; 
xl := xl + del ; 
end ; 

r5 := r5 / xn ; 

r7 : = sqrt ( r7 / xn ) ; 

if ( j = 1 ) then begin 

writelnC TEST OF ARCTAN(X) VS TRUNCATED TAYLOR SERIES'); 

writeln; 
end; 
if ( j = 2 ) then begin 

writeC TEST OF ARCTAN(X) VS ARCTAN (1/16) + •); 

writelnC ' ARCTAN ( (X-l/16) /(l+X/16) ) • ) ; 

writeln; 
end; 
if ( j > 2 ) then begin 

writelnC TEST OF 2*ARCTAN(X) VS ARCTAN (2X/(1-X*X) ) ') ; 

writeln; 
end; 

printtestrun(n,a,b,k,kl,r5,r6,xl,r7); 
a := b ; 



= 2.0 - sqrt ( 3.0 ); 
= sqrt ( 2.0 )- one ; 
= one ; 



if ( j = 1 ) then b 

if ( j = 2 ) then b 

if ( j = 3 ) then b 
end ; 

special tests 

writelnC THE IDENTITY ARCTAN (-X) = -ARCTAN (X) WILL BE TESTED 1 ); 
writelnC *:7, 'X 1 , • »:9, 'F(X) +F(-X)'); 
writeln; 
a := 5.0 ; 

for i := 1 to 5 do begin 

x := random * a ; 

z := arctan ( x )+ arctan ( - x ); 

writeln(x:14, z:15); 
end ; 
writeln; 

writelnC THE IDENTITY ARCTAN (X) = X, X SMALL, WILL BE TESTED'); 

writelnC ':7, 'X 1 , • »:9, 'X-F(X)'); 

writeln; 

betap := exp ( it * ln( beta )); 

x := random / betap ; 

for i := 1 to 5 do begin 

z := x - arctan ( x ) ; 

writeln(x:14, z:15); 

x := x / beta ; 
end ; 
writeln; 
writeln; 

writelnC TEST OF UNDERFLOW FOR A VERY SMALL ARGUMENT'); 

writeln; 

expon := ( minexp )* 0.75 ; 
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00588300 
00588400 
00588500 
00588600 
00588700 
00588800 
00588900 
00589000 
00589100 
00589200 
00589300 
} 00589400 
00589500 
00589600 
00589700 
00589800 
00589900 
00590000 
00590100 
00590200 
00590300 
00590400 
00590500 
00590600 
00590700 
00590800 
00590900 
00591000 
00591100 
00591200 
00591300 
00591400 
00591500 
00591600 
00591700 
00591800 
00591900 
00592000 
00592100 
00592200 
00592300 



x := exp ( expon * ln( beta )); 

y := arctan ( x ) ; 

writelnC ':5, • ARCTAN(' f x:13, ') = ', y:13); 

writeln; 

writeC THE FUNCTION WILL BE CALLED WITH THE ARGUMENT 1 ); 

writeln(xmax:15); 

z := arctan ( xmax ) ; 

writelnC ':5, • ARCTAN C f xmax:13, ') = \ z:13); 

writeln; 

writelnC THIS CONCLUDES THE TESTS'); 
end. 
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00592500 
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00592800 
00592900 
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00593200 
00593300 
00593400 
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{TEST 6.6.6.2-8, CLASS=QUALITY} 

{ This test checks the implementation of the exp function. } 

program t6p6p6p2d8 (output) ; 

var 



{ 



data required 

none 
other subprograms in this package 



machar 
random 



as for sqrtest 
as for sqrtest 



standard subprograms required 
abs, In, exp, sqrt 



i , ibeta , iexp , irnd , it , il , j , k , kl , machep , 

iy , max exp , minexp , n , negep , ngrd : integer ; 

a , albeta , b , beta , d , del , eps , epsneg , r5 , r6 , r7 , v , 

w , x , xl , xmax , xmin , xn , xl , y , z , zz : real ; 

procedure machar (var ibeta , it , irnd , ngrd , machep , negep , iexp, 
minexp , maxexp : integer ; var eps , epsneg , xmin , xmax : real ) ; 



This subroutine is intended to determine the characteristics 
of the floating-point arithmetic system that are specified 
below. The first three are determined according to an 
algorithm due to M. Malcolm, CACM 15 (1972), pp. 949-951, 
incorporating some, but not all, of the improvements 
suggested by M. Gentleman and S. Marovich, CACM 17 (1974) , 
pp. 276-277. The version given here is for single precision. 

Latest revision - October 1, 1976. 

Author - W. J. Cody 

Argonne National Laboratory 

Revised for Pascal - R. A. Freak 

University of Tasmania 

Hobart 

Tasmania 

ibeta is the radix of the floating-point representation 

it is the number of base ibeta digits in the floating-point 

significand 
irnd = if the arithmetic chops, 

1 if the arithmetic rounds 
ngrd = if irnd=l, or if irnd=0 and only it base ibeta 

digits participate in the post normalization shift 
of the floating-point significand in multiplication 



00593500 
00593600 
00593700 
00593800 
00593900 
00594000 
00594100 
00594200 
00594300 
00594400 
00594500 
00594600 
00594700 
00594800 
00594900 
00595000 
00595100 
00595200 
00595300 
00595400 
00595500 
00595600 
00595700 
00595800 
00595900 
00596000 
00596100 
00596200 
00596300 
00596400 
00596500 
00596600 
00596700 
00596800 
00596900 
00597000 
00597100 
00597200 
00597300 
00597400 
00597500 
00597600 
00597700 
00597800 
00597900 
00598000 
00598100 
00598200 
00598300 
00598400 
00598500 
00598600 
00598700 
00598800 
00598900 
00599000 
00599100 
00599200 
00599300 
00599400 
00599500 



1 if irnd=0 and more than it base ibeta digits 
participate in the post normalization shift of the 
floating-point significand in multiplication 
machep is the exponent on the smallest positive floating-point 

number eps such that 1.0+eps <> 1.0 
negeps is the exponent on the smallest positive fl. pt. no. 

negeps such that 1.0-negeps <> 1.0, except that 

negeps is bounded below by it-3 
iexp is the number of bits (decimal places if ibeta = 10) 

reserved for the representation of the exponent of 

a floating-point number 
minexp is the exponent of the smallest positive fl. pt. no. 

xmin 
maxexp is the exponent of the largest finite floating-point 

number xmax 
eps is the smallest positive floating-point number such 

that 1.0+eps <> 1.0. in particular, 

eps = ibeta**machep 
epsneg is the smallest positive floating-point number such 

that 1.0-eps <> 1.0 (except that the exponent 

negeps is bounded below by it-3) . in particular 

epsneg = ibeta* *negep 
xmin is the smallest positive floating-point number, in 

particular, xmin = ibeta ** minexp 
xmax is the largest finite floating-point number, in 

particular xmax = (1.0-epsneg) * ibeta ** maxexp 

note - on some machines xmax will be only the 

second, or perhaps third, largest number, being 

too small by 1 or 2 units in the last digit of 

the significand. 



} 



i , iz , j , k , mx : integer ; 

a , b , beta , Detain , betaml , one , y , z , zero : real ; 

under flo : boolean; 

begin 

irnd := 1 ; 
one := ( irnd ); 
a := one + one ; 
b := a ; 
zero := 0.0 ; 



{ 



determine ibeta, beta ala Malcolm 

while ( ( ( a + one ) - a ) - one = zero ) do begin 

a := a + a ; 
end ; 
while ( ( a + b ) - a = zero ) do begin 

b := b + b ; 
end ; 

ibeta : = trunc ( ( a + b ) - a ) ; 
beta := ( ibeta ) ; 
betaml := beta - one ; 

determine irnd, ngrd, it 

if ( ( a + betaml ) - a = zero ) then irnd := ; 
it := ; 
a := one ; 



00599600 
00599700 
00599800 
00599900 
00600000 
00600100 
00600200 
00600300 
00600400 
00600500 
00600600 
00600700 
00600800 
00600900 
00601000 
00601100 
00601200 
00601300 
00601400 
00601500 
00601600 
00601700 
00601800 
00601900 
00602000 
00602100 
00602200 
00602300 
00602400 
00602500 
00602600 
00602700 
00602800 
00602900 
00603000 
00603100 
00603200 
00603300 
00603400 
00603500 
00603600 
00603700 
00603800 
00603900 
00604000 
00604100 
00604200 
00604300 
00604400 
00604500 
00604600 
00604700 
00604800 
00604900 
00605000 
00605100 
00605200 
00605300 
00605400 
00605500 
00605600 
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repeat begin 

it := it + 1 ; 

a := a * beta ; 
end until ( ( ( a + one ) - a ) - one <> zero } ; 

determine negep, epsneg 

negep := it + 3 ; 
a := one ; 

for i := 1 to negep do begin 

a := a / beta ; 
end ; 

while ( ( one - a ) - one = zero ) do begin 

a := a * beta ; 

negep := negep - 1 ; 
end ; 

negep := - negep ; 
epsneg := a ; 

determine machep, eps 

machep := negep ; 

while ( ( one + a ) - one = zero ) do begin 

a := a * beta ; 

machep := machep + 1 ; 
end ; 
eps := a ; 

determine ngrd 

ngrd := ; 

if(( irnd = 0) and((( one + eps) * one - one) <> zero)) then 

ngrd := 1 ; 

determine iexp, minexp, xmin 

loop to determine largest i such that 

(1/beta) ** (2**(i)) 
does not underflow 
exit from loop is signal 1 by an underflow 

i := ; 

betain := one / beta ; 

z := betain ; 

under flo := false; 

repeat begin 

y :» z ; 

z := y * y ; 

check for underflow 

if ( ( z * one = zero ) or ( abs ( z )> y ) ) then begin 

underflo := true; 
end else begin 
i := i + 1 ; 
end; 
end until underflo ; 
k := 1 ; 



00605700 
00605800 
00605900 
00606000 
00606100 
00606200 
00606300 
00606400 
00606500 
00606600 
00606700 
00606800 
00606900 
00607000 
00607100 
00607200 
00607300 
00607400 
00607500 
00607600 
00607700 
00607800 
00607900 
00608000 
00608100 
00608200 
00608300 
00608400 
00608500 
00608600 
00608700 
00608800 
00608900 
00609000 
00609100 
00609200 
00609300 
00609400 
00609500 
00609600 
00609700 
00609800 
00609900 
00610000 
00610100 
00610200 
00610300 
00610400 
00610500 
00610600 
00610700 
00610800 
00610900 
00611000 
00611100 
00611200 
00611300 
00611400 
00611500 
00611600 
00611700 



determine k such that (1/beta) **k does not underflow 
first set k = 2 ** i 



for j := 1 to i do begin 

k := k + k ; 
end ; 

iexp := i + 1 ; 
mx 5= k + k ; 

if ( ibeta = 10 ) then begin 
{ 

for decimal machines only 

iexp := 2 ; 

iz := ibeta ; 

while ( k >= iz ) do begin 
iz := iz * ibeta ; 
iexp := iexp + 1 ; 

end ; 

mx := iz + iz - 1 ; 
end; 

underflo := false; 
repeat begin 

{ 

loop to construct xmin 

exit from loop is signalled by an underflow 

xmin := y ; 

y := y * betain ; 

if ( ( ( y * one ) = zero ) or ( abs ( y )> xmin ) ) 

then begin 

underflo := true; 
end else begin 
k := k + 1 ; 
end; 
end until underflo ; 
minexp : = - k ; 
{ determine maxexp, xmax 

if((mx<=k+k-3)and( ibeta <> 10 ) ) then begin 
mx := mx + mx ; 
iexp := iexp + 1 ; 
end; 

maxexp := mx + minexp ; 
{ adjust for machines with implicit leading 
bit in binary significand and machines with 
radix point at extreme right of significand 

i := maxexp + minexp ; 

if ( ( ibeta = 2 ) and ( i = ) ) then maxexp := maxexp - 1 ; 

if ( i > 20 ) then maxexp := maxexp - 3 ; 

xmax := one - epsneg ; 

if ( xmax * one <> xmax ) then xmax := one - beta * epsneg ; 

xmax := ( xmax * betain * betain * betain ) / xmin ; 

i := maxexp + minexp + 3 ; 

if ( i > ) then begin 

for j := 1 to i do begin 
xmax := xmax * beta ; 
end ; 
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end; 
end; 

function random : real ; 

{ random number generator - based on algorithm 266 
by Pike and Hill (modified by Hansson) 
collected Alg. from CACM. 

This subprogram is intended for use on computers with 
fixed point wordlength of at least 29 bits, it is 
best if the floating point significand has at most 
29 bits. } 

{ The quality of the random numbers is not important. 

If recoding is needed for small wordlength computers, 
even returning a constant value or zero is possible. } 

{ The value iy is global, and is initialized in the driver } 

begin 

iy := (iy*125) mod 2796203; 

random : = ( iy )/ 2796203. OeO ; 
end; 



procedure printtestrun (n: integer; lb,ub:real; 

big, small : integer; 

mean ,maxer ror ,xmaxer ror ,rmser ror : real ) ; 
begin 

writelnC ':5,n:4,' RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL 1 ) 

writelnC MO,' C ,lb:15,' ,' ,ub:15,») ') ; 

writeln; 

writelnC *:5,'THE RESULT WAS TOO LARGE 1 , big: 5, ' TIMES, AND 1 ); 

writelnC 'tlO/TOO SMALL* , small: 5,' TIMES'); 

writeln; 

if (mean <> 0.0) then begin 

writelnC ' :5,'MEAN RELATIVE ERROR =' ,mean:l5,'=' , 
IBETA:4,' ** ' ^(ABSdneanM/ALBETA^^K- 
end; 
if (maxerrorO 0.0) then begin 

writelnC '^/THE MAXIMUM RELATIVE ERROR OF 1 ,maxerror :15, ' = ' , 
IBETA:4,' ** • ,E*1 (ABS (max error) )/ALBETA:7:2) ; 

writelnC ': 10,' OCCURRED FOR X = ■ ,xmaxerror:15); 
end; 
if (rmserror <> 0.0) then begin 

writelnC ' :5,» ROOT-MEAN-SQUARE RELATIVE ERROR =', rmserror: 15, 
^MBETAtV ** ' ,LN (ABS (rmserror) )/ALBETA:7: 2); 
end; 

writeln; 
end; { OF PRINT TEST RUN } 



begin 

iy := 100001; 

machar ( ibeta , it , irnd , ngrd , machep , negep , iexp , minexp 

maxexp , eps , epsneg , xmin , xmax ) ; 
beta := ( ibeta ); 



00617900 
00618000 
00618100 
00618200 
00618300 
00618400 
00618500 
00618600 
00618700 
00618800 
00618900 
00619000 
00619100 
00619200 
00619300 
00619400 
00619500 
00619600 
00619700 
00619800 
00619900 
00620000 
00620100 
00620200 
00620300 
00620400 
00620500 
00620600 
00620700 
00620800 
00620900 
00621000 
00621100 
00621200 
00621300 
00621400 
00621500 
00621600 
00621700 
00621800 
00621900 
00622000 
00622100 
00622200 
00622300 
00622400 
00622500 
00622600 
00622700 
00622800 
00622900 
00623000 
00623100 
00623200 
00623300 
00623400 
00623500 
00623600 
00623700 
00623800 
00623900 



albeta := In ( beta ) ; 

v := 0.0625 ; 

a := 2.0 ; 

b := In ( a )* 0.5 ; 

a := - b + v ; 

d := 0.9 * xmax ; 

d := In ( d ); 

n := 2000 ; 

xn := ( n ); 

il := ; 



random argument accuracy tests 



for j := 1 to 3 do begin 
k := ; 
kl := ; 
xl := 0.0 
r5 := 0.0 
r6 := 0.0 
r7 := 0.0 
del := ( b - a ) / xn ; 
xl := a ; 

for i := 1 to n do begin 
x := del * random + xl ; 
y := x - v ; 

if ( y < 0.0 ) then x := y + v ; 
z := exp ( x ) ; 
zz := exp ( y ) ; 
if ( j = 1 ) then begin 

z := z - z * 6.058693718652421388e-2 ; 
end else begin 

if ( ibeta = 10 ) then z := z * 6.0e-2 + z * 

5. 466789530794296106e-5 
else z := z * 0.0625 - z * 
2.4453321046920570389e-3 ; 



end; 



w : 


= ( z 


- 


zz 


) / zz ; 






if 


( w < 


0. 


) 


then k := 


k + 


1 


if 


( w > 


0. 


) 


then kl := 


= kl 


+ 


r5 


:= r5 


+ 


w ; 








w : 


= abs 


( 


w ) 








if 


( w > 


r6 ) 


then begin 








r6 : = 


w 


/ 










xl : = 


X 


• 








enc 


; 












r7 


:= r7 


+ 


w * 


w ; 






xl 


:= xl 


+ 


del 


; 






end ; 















r5 := r5 / xn ; 

r7 := sqrt ( r7 / xn ) ; 

writelnC TEST OF EXP(X-', v:7:4, ') VS EXP(X)/EXP(', v:7:4, 

writeln; 

printtestrun(n,a,b,k,kl,r5,r6,xl,r7) ; 

if ( j = 2 ) then begin 

a := - 2.0 * a ; 

b := 10.0 * a ; 

if ( b < d ) then b := d ; 
end else begin 

v := 45.0 / 16.0 ; 



00624000 
00624100 
00624200 
00624300 
00624400 
00624500 
00624600 
00624700 
00624800 
00624900 
00625000 
00625100 
} 00625200 
00625300 
00625400 
00625500 
00625600 
00625700 
00625800 
00625900 
00626000 
00626100 
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00626600 
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00627000 
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00627800 
00627900 
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00629000 
00629100 
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00629700 
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a := - 10.0 * b ; 

b := 4.0 * xmin * exp ( it * ln( beta )); 
b := In ( b ); 
end; 



end 

special tests 

writelnC THE IDENTITY EXP(X) * EXP(-X) - 1.0 WILL BE TESTED.'); 

writelnC ':7,*X', ' ':9, *F(X)*F(-X) - 1*); 

writeln; 

for i := 1 to 5 do begin 

x := random * beta ; 

y := - x ; 

z := exp ( x )* exp ( y )- 1.0 ; 

writeln(x:15, z:15); 
end ; 
writeln; 

writelnC TEST OF SPECIAL ARGUMENTS'); 
writeln; 
x := 0.0 ; 

y := exp ( x )- 1.0 ; 
writelnC EXP(O.O) - 1.0 = ', y:15); 
writeln; 

x := trunc ( In ( xmin ) ) ; 
y := exp ( x ); 

writelnC EXP(', x:13, ') = *, z:15); 
writeln; 

x := trunc ( In ( xmax )); 
y := exp ( x ); 

writelnC EXP(', x:13, ') = *, y:15); 
writeln; 
x := x / 2.0 ; 
v := x / 2.0 ; 
y := exp ( x ); 
z := exp ( v ); 
z := z * z ; 

writelnC IF EXP(\ x:13, ») = ', y:15, ' IS NOT ABOUT*); 
writeC EXP(', v:13 f ')**2 = ', z:15, ' THERE IS AN ARGUMENT'); 
writelnC REDUCTION ERROR 1 ); 
writeln; 

test of error returns 



end. 



writelnC TEST OF ERROR RETURNS'); 

writeln; 

x := - 1.0 / sqrt ( xmin ); 

writelnC EXP WILL BE CALLED WITH THE ARGUMENT*, x:15); 

writelnC THIS SHOULD UNDERFLOW AND MAYBE PRODUCE ZERO OR AN ERROR*) 

; 

writeln; 

y := exp ( x ) ; 

writelnC EXP RETURNED THE VALUE * r y:15); 

writeln; 

writeln (* THIS CONCLUDES THE TESTS'); 



00630100 
00630200 
00630300 
00630400 
00630500 
00630600 
00630700 
00630800 
00630900 
00631000 
00631100 
00631200 
00631300 
00631400 
00631500 
00631600 
00631700 
00631800 
00631900 
00632000 
00632100 
00632200 
00632300 
00632400 
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00632600 
00632700 
00632800 
00632900 
00633000 
00633100 
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00633300 
00633400 
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00633600 
00633700 
00633800 
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00634700 
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00635000 
00635100 
00635200 
00635300 
00635400 
00635500 
00635600 
00635700 



{TEST 6.6.6.2-9, CLASS=QUALITY} 

{ This test checks the implementation of the sin and cos functions. } 

program t6p6p6p2d9 (output) ; 

var 

{ data required 

none 

other subprograms in this package 

machar - as for sqrtest 
random - as for sqrtest 

standard subprograms required 
abs, In, exp, cos, sin, sqrt 



i , ibeta , iexp , irnd , it , il , j , k , kl , machep , 

iy , maxexp , minexp , n , negep , ngrd : integer ; 

a , albeta , b , beta , betap , c , del , eps , epsneg , expon , r5, 

r6 , r7 , w , x , xl , xmax , xmin , xn , xl , y , z , zz : real ; 

procedure machar (var ibeta , it , irnd , ngrd , machep , negep , iexp, 
minexp , maxexp : integer ; var eps , epsneg , xmin , xmax : real ) ; 



This subroutine is intended to determine the characteristics 
of the floating-point arithmetic system that are specified 
below. The first three are determined according to an 
algorithm due to M. Malcolm, CACM 15 (1972), pp. 949-951, 
incorporating some, but not all, of the improvements 
suggested by M. Gentleman and S. Marovich, CACM 17 (1974) , 
pp. 276-277. The version given here is for single precision. 

Latest revision - October 1, 1976. 



Author 



W. J. Cody 

Argonne National Laboratory 



Revised for Pascal - R. A. Freak 

University of Tasmania 

Hobart 

Tasmania 



ibeta 
it 



irnd 



ngrd 



is the radix of the floating-point representation 

is the number of base ibeta digits in the floating-point 

significand 
= if the arithmetic chops, 
1 if the arithmetic rounds 
= if irnd=l, or if irnd=0 and only it base ibeta 
digits participate in the post normalization shift 
of the floating-point significand in multiplication 
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00635900 
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1 if irnd=0 and more than it base ibeta digits 
participate in the post normalization shift of the 
floating-point significand in multiplication 
machep is the exponent on the smallest positive floating-point 

number eps such that 1.0+eps <> 1.0 
negeps is the exponent on the smallest positive fl. pt. no. 

negeps such that 1.0-negeps <> 1.0, except that 

negeps is bounded below by it-3 
iexp is the number of bits (decimal places if ibeta = 10) 

reserved for the representation of the exponent of 

a floating-point number 
minexp is the exponent of the smallest positive fl. pt. no. 

xmin 
maxexp is the exponent of the largest finite floating-point 

number xmax 
eps is the smallest positive floating-point number such 

that 1.0+eps <> 1.0. in particular, 

eps = ibeta* *machep 
epsneg is the smallest positive floating-point number such 

that 1.0-eps <> 1.0 (except that the exponent 

negeps is bounded below by it-3) . in particular 

epsneg = ibeta* *negep 
xmin is the smallest positive floating-point number, in 

particular, xmin = ibeta ** minexp 
xmax is the largest finite floating-point number, in 

particular xmax = (1.0-epsneg) * ibeta ** maxexp 

note - on some machines xmax will be only the 

second, or perhaps third, largest number, being 

too small by 1 or 2 units in the last digit of 

the significand. 



} 



i , iz , j , k , mx : integer ; 

a , b , beta , betain , betaml , one , y , z , zero : real ; 

underflo : boolean; 

begin 

irnd : = 1 ; 
one := ( irnd ) ; 
a := one + one ; 
b := a ; 
zero := 0.0 ; 



{ 



determine ibeta, beta ala Malcolm 

while ( ( ( a + one ) - a ) - one = zero ) do begin 

a := a + a ; 
end ; 
while ( ( a + b ) - a = zero ) do begin 

b := b + b ; 
end ; 

ibeta := trunc ( ( a + b ) - a ) ; 
beta := ( ibeta ); 
betaml := beta - one ; 

determine irnd,ngrd,it 

if ( ( a + betaml ) - a = zero ) then irnd := ; 
it := ; 
a := one ; 
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00642400 
00642500 
00642600 
00642700 
00642800 
00642900 
00643000 
00643100 
00643200 
00643300 
00643400 
00643500 
00643600 
00643700 
00643800 
00643900 
00644000 
00644100 
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00645500 
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00647600 
00647700 
00647800 
00647900 



repeat begin 

it := it + 1 ; 

a := a * beta ; 
end until ( ( ( a + one ) - a ) - one <> zero ) ; 

determine negep, epsneg 

negep := it + 3 ; 
a := one ; 

for i := 1 to negep do begin 

a := a / beta ; 
end ; 

while ( ( one - a ) - one = zero ) do begin 

a := a * beta ; 

negep := negep - 1 ; 
end ; 

negep := - negep ; 
epsneg := a ; 

determine machep, eps 

machep := negep ; 

while ( ( one + a ) - one = zero ) do begin 

a := a * beta ; 

machep := machep + 1 ; 
end ; 
eps := a ; 

determine ngrd 

ngrd := ; 

if(( irnd = 0) and((( one + eps) * one - one) <> zero)) then 

ngrd : = 1 ; 

determine iexp, minexp, xmin 

loop to determine largest i such that 

(1/beta) ** (2**(i)) 
does not underflow 
exit from loop is signal 1 by an underflow 

i := ; 

betain := one / beta ; 
z := betain ; 
underflo := false; 
repeat begin 

y := z ; 

z :- y * y ; 

check for underflow 

if ( ( z * one = zero ) or ( abs ( z )> y ) ) then begin 

underflo := true; 
end else begin 
i :- i + 1 ; 
end; 
end until underflo ; 
k := I ; 
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determine k such that (l/beta)**k does not underflow 
first set k = 2 ** i 



for j := 1 to i do begin 

k := k + k ; 
end ; 

iexp := i + 1 ; 

mx := k + k ; 

if ( ibeta = 10 ) then begin 

{ 

for decimal machines only 
iexp := 2 ; 
iz := ibeta ; 

while ( k >= iz ) do begin 
iz := iz * ibeta ; 
iexp := iexp + 1 ; 
end ; 

mx := iz + iz - 1 ; 
end; 

under flo := false; 
repeat begin 

{ 

loop to construct xmin 

exit from loop is signalled by an underflow 

xmin := y ; 

y := y * Detain ; 

if ( ( ( y * one ) = zero ) or ( abs ( y )> xmin ) ) 

then begin 

under flo := true; 
end else begin 
k := k + 1 ; 
end; 
end until under flo ; 
minexp := - k ; 
{ determine maxexp, xmax 



then begin 



if ( ( mx <= k + k - 3 ) and ( ibeta <> 10 ) 
mx := mx + mx ; 
iexp :- iexp + 1 ; 
end; 

maxexp := mx + minexp ; 
{ adjust for machines with implicit leading 
bit in binary significand and machines with 
radix point at extreme right of significand 



i := maxexp + minexp ; 

if ( ( ibeta = 2 ) and ( i = ) ) then maxexp := maxexp - 1 

if ( i > 20 ) then maxexp := maxexp - 3 ; 

xmax := one - epsneg ; 

if ( xmax * one <> xmax ) then xmax := one - beta * epsneg ; 

xmax := ( xmax * Detain * Detain * betain ) / xmin ; 

i := maxexp + minexp + 3 ; 

if ( i > ) then begin 



for j := 1 to i do begin 
xmax := xmax * beta ; 
end ; 
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end; 
end; 

function random : real ; 

{ random number generator - based on algorithm 266 
by Pike and Hill (modified by Hansson) 
collected Alg. from CACM. 

This subprogram is intended for use on computers with 
fixed point wordlength of at least 29 bits, it is 
best if the floating point significand has at most 
29 bits. } 

{ The quality of the random numbers is not important. 

If recoding is needed for small wordlength computers, 
even returning a constant value or zero is possible. } 

{ The value iy is global, and is initialized in the driver } 

begin 

iy := (iy*125) mod 2796203; 

random := ( iy )/ 2796203. OeO ; 
end; 



procedure printtestrun (n: integer; lb,ub:real; 

big, small : integer; 

mean ,maxerror ,xmaxerror , rmser ror : real) ; 
begin 

writelnC * :5,n:4,» RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL 1 ) 

writelnC »:10,' (' ,lb:15,' ,' ,ub:15,') '); 

writeln; 

writelnC »:5,'THE RESULT WAS TOO LARGE 1 , big: 5, ' TIMES, AND'); 

writelnC ': 10, 'TOO SMALL' , small : 5, ' TIMES'); 

writeln; 

if (mean <> 0.0) then begin 

writelnC ':5,»MEAN RELATIVE ERROR =' ,mean:15, '=' , 
IBETA:4,' ** ' ,LN (ABS (mean) )/ALBETA: 7:2) ; 
end; 
if (maxerrorO 0.0) then begin 

writelnC , :5, I THE MAXIMUM RELATIVE ERROR OF' ,maxerror :15, '=' , 
IBETA:4,' ** ' ,LN (ABS(maxerror) ) /ALBETA:7: 2) ; 

writelnC ': 10 ,' OCCURRED FOR X =' ,xmaxerror:15); 
end; 
if (rmser ror <> 0.0) then begin 

writelnC ': 5, ' ROOT-MEAN-SQUARE RELATIVE ERROR =' ,rmserror:15, 
^MBETA^,' ** ' ,LN (ABS (rmser ror)) /ALBETA: 7:2) ; 
end; 

writeln; 
end; { OF PRINT TEST RUN } 



begin 

iy := 100001; 

machar ( ibeta , it , irnd , ngrd , machep , negep , iexp , minexp , 

maxexp , eps , epsneg , xmin , xmax ) ; 
beta := ( ibeta ) ; 



00660200 
00660300 
00660400 
00660500 
00660600 
00660700 
00660800 
00660900 
00661000 
00661100 
00661200 
00661300 
00661400 
00661500 
00661600 
00661700 
00661800 
00661900 
00662000 
00662100 
00662200 
00662300 
00662400 
00662500 
00662600 
00662700 
00662800 
00662900 
00663000 
00663100 
00663200 
00663300 
00663400 
00663500 
00663600 
00663700 
00663800 
00663900 
00664000 
00664100 
00664200 
00664300 
00664400 
00664500 
00664600 
00664700 
00664800 
00664900 
00665000 
00665100 
00665200 
00665300 
00665400 
00665500 
00665600 
00665700 
00665800 
00665900 
00666000 
00666100 
00666200 



CO 
O 



CO 



O 
O 



O 
CO 



70 






CD 






albeta := In ( beta ); 

a := 0.0 ; 

b := 1.570796327 ; 

c := b ; 

n := 2000 ; 

xn := ( n ) ; 

il := ; 

random argument accuracy tests 

for j := 1 to 3 do begin 
k := ; 
kl := ; 
xl := 0.0 
r5 := 0.0 
r6 := 0.0 
r7 := 0.0 
del := ( b - a ) / xn ; 
xl := a ; 

for i := 1 to n do begin 
x := del * random + xl ; 
y := x / 3.0 ; 
y := ( x + y ) - x ; 
x := 3.0 * y ; 
if ( j = 3 ) then begin 

z : = cos ( x ) ; 

zz := cos ( y ) ; 

w := ( z + zz * ( 3.0 - 4.0 * zz * zz ) ) / z ; 
end else begin 

z := sin ( x ); 

zz := sin ( y ) ; 

w := ( z - zz * ( 3.0 - 4.0 * zz * zz ) ) / z ; 
end; 

if ( w > 0.0 ) then k := k + 1 ; 
if ( w < 0.0 ) then kl : = kl + 1 ; 
r5 := r5 + w ; 
w : = abs ( w ) ; 
if ( w > r6 ) then begin 

r6 := w ; 

xl := x ; 
end; 

r7 := r7 + w * w ; 
xl := xl + del ; 
end ; 

r5 := r5 / xn ; 

r7 : = sqrt ( r7 / xn ) ; 

if ( j = 3 ) then begin 

writelnC TEST OF COS(X) VS 4*COS(X/3)**3-3*COS(X/3) ') ; 

writeln; 
end else begin 

writelnC TEST OF SIN(X) VS 3*SIN(X/3)-4*SIN(X/3)**3') ; 

writeln; 
end; 

printtestrun(n,a,b,k,kl,r5,r6,xl,r7); 
a := 18.84955592 ; 
if ( j = 2 ) then a := b + c ; 
b := a + c ; 
end ; 
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special tests 

c := 1.0 / exp ( ( it div 2 ) * ln( beta )); 

z := ( sin ( a + c )- sin (a-c))/(c+c); 

writeC IF ', z:15,' IS NOT ALMOST 1.0 THEN SIN HAS THE WRONG '); 

writeln ('PERIOD'); 

writeln; 

writelnC THE IDENTITY -SIN(X) = -SIN(X) WILL BE TESTED 1 ); 

writelnC ':7, 'XV ' :9 f f F(X) + F(-X) ') ; 

writeln; 

for i := 1 to 5 do begin 

x := random * a ; 

z := sin ( x )+ sin ( - x ) ; 

writeln(x:14,z:15); 
end ; 

writeln; 

writelnC THE IDENTITY SIN(X) = X, X SMALL, WILL BE TESTED.'); 

writelnC ':7, ■X',' ' :9, 'X - F(X) ') ; 

writeln; 

betap := exp ( it * ln( beta )); 

x := random / betap ; 

for i := 1 to 5 do begin 

z := x - sin ( x ) ; 

writeln(x:14, z:15); 

x := x / beta ; 
end ; 
writeln; 

writelnC THE IDENTITY COS(-X) = COS(X) WILL BE TESTED.'); 

writelnC ':7,'XV ':9,'F(X) -F(-X)'); 

writeln; 

for i := 1 to 5 do begin 

x := random * a ; 

z : = cos ( x ) - cos ( - x ) ; 

writeln(x:14, z:15); 
end ; 
writeln; 

writelnC TEST OF UNDERFLOW FOR VERY SMALL ARGUMENTS'); 

writeln; 

expon := ( minexp )* 0.75 ; 

x := exp ( expon * ln( beta )); 

y := sin ( x ) ; 

writelnC ':5, *SIN(', x:15, ') = ', y:15); 

writeln; 

writelnC THE FOLLOWING THPPF: LINES ILLUSTRATE THE LOSS IN*); 

writelnC SIGNIFICANCE FOR iARGE ARGUMENTS. THE ARGUMENTS'); 

writelnC USED ARE CONSECUTIVE.'); 

writeln; 

z := sqrt ( betap ) ; 

x := z * ( 1.0 - epsneg ) ; 

y := sin ( x ) ; 

writelnC ':5, 'SINC, x:15, ') = ', y:15); 

writeln; 

y := sin ( z ) : 

writelnC »:5, 'SINC, z:15, ') = ', y:15); 
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writeln; 

x := z * ( 1.0 + eps ) ; 

y := sin ( x ) ; 

writelnC »:5, 'SINC, x:15, ') = ', y:15); 

writeln; 

x := betap ; 

writelnC SIN(X) WILL BE CALLED WITH THE ARGUMENT ' , x:15); 

y := sin ( x ); 

writelnC SIN RETURNED THE VALUE *, y:15); 

writeln( f THIS CONCLUDES THE TESTS.'); 



end. 
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{TEST 6.6.6.2-10, CLASS=QUALITY} 

{ This test checks the implementation of the In function. } 

program t6p6p6p2dl0 (output) ; 

var 

{ data required 

none 

other subprograms in this package 

machar - as for sqrtest 
ran(k) - as for sqrtest 

standard subprograms required 
abs, In, sqrt 



i , ibeta , iexp , irnd , it , il , j , k , kl , machep , 
iy , maxexp , minexp , n , negep , ngrd : integer ; 

a , albeta , b , beta , d , del , eight , eps , epsneg , half , r5 , 
r6 , r7 , tenth , w , x , xl , xmax , xmin , xn , xl , y , z ,zz: 
real ; 

procedure machar (var ibeta , it , irnd , ngrd , machep , negep , iexp, 
minexp , maxexp : integer ; var eps , epsneg , xmin , xmax : real ) ; 



This subroutine is intended to determine the characteristics 
of the floating-point arithmetic system that are specified 
below. The first three are determined according to an 
algorithm due to M. Malcolm, CACM 15 (1972), pp. 949-951, 
incorporating some, but not all, of the improvements 
suggested by M. Gentleman and S. Marovich, CACM 17 (1974) , 
pp. 276-277. The version given here is for single precision. 

Latest revision - October 1, 1976. 

Author - W. J. Cody 

Argonne National Laboratory 

Revised for Pascal - R. A. Freak 

University of Tasmania 

Hobart 

Tasmania 
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is the radix of the floating-point representation 

is the number of base ibeta digits in the floating-point 

significand 
= if the arithmetic chops, 

1 if the arithmetic rounds 
= if irnd=l, or if irnd=0 and only it base ibeta 
digits participate in the post normalization shift 



mm 
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of the floating-point significant} in multiplication 

1 if irnd=0 and more than it base ibeta digits 
participate in the post normalization shift of the 
floating-point significant in multiplication 
machep is the exponent on the smallest positive floating-point 

number eps such that 1.0+eps <> 1.0 
negeps is the exponent on the smallest positive fl. pt. no. 

negeps such that 1.0-negeps <> 1.0, except that 

negeps is bounded below by it-3 
iexp is the number of bits (decimal places if ibeta = 10) 

reserved for the representation of the exponent of 

a floating-point number 
minexp is the exponent of the smallest positive fl. pt. no. 

xmin 
maxexp is the exponent of the largest finite floating-point 

number xmax 
eps is the smallest positive floating-point number such 

that 1.0+eps <> 1.0. in particular, 

eps = ibeta* *machep 
epsneg is the smallest positive floating-point number such 

that 1.0-eps <> 1.0 (except that the exponent 

negeps is bounded below by it-3). in particular 

epsneg = ibeta**negep 
xmin is the smallest positive floating-point number, in 

particular, xmin = ibeta ** minexp 
xmax is the largest finite floating-point number, in 

particular xmax = (1.0-epsneg) * ibeta ** maxexp 

note - on some machines xmax will be only the 

second, or perhaps third, largest number, being 

too small by 1 or 2 units in the last digit of 

the significand. 



} 



i , iz , j , k , mx : integer ; 

a , b , beta , beta in , betaml , one , y , z , zero : real 

under flo : boolean; 

begin 

irnd := 1 ; 
one := ( irnd ) ; 
a := one + one ; 
b := a ; 
zero := 0.0 ; 



{ 



determine ibeta, beta ala Malcolm 

while ( ( ( a + one ) - a ) - one = zero ) do begin 

a := a + a ; 
end ; 
while ( ( a + b ) - a = zero ) do begin 

b := b + b ; 
end ; 

ibeta := trunc ( ( a + b ) - a ); 
beta := ( ibeta ); 
betaml := beta - one ; 

determine irnd,ngrd,it 

if ( ( a + betaml ) - a = zero ) then irnd := ; 
it := ; 
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a := one ; 
repeat begin 

it := it + 1 ; 

a := a * beta ; 
end until ( ( ( a + one ) - a ) - one <> zero ) ; 

determine negep, epsneg 

negep := it + 3 ; 
a := one ; 

for i := 1 to negep do begin 

a := a / beta ; 
end ; 

while ( ( one - a ) - one = zero ) do begin 

a :- a * beta ; 

negep := negep - 1 ; 
end ; 

negep := - negep ; 
epsneg := a ; 

determine machep, eps 

machep := negep ; 

while ( ( one + a ) - one = zero ) do begin 

a := a * beta ; 

machep := machep + 1 ; 
end ; 
eps := a ; 

determine ngrd 

ngrd := ; 

if(( irnd = 0) and((( one + eps) * one - one) <> zero)) then 

ngrd : = 1 ; 

determine iexp, minexp, xmin 

loop to determine largest i such that 

(1/beta) ** (2**(i)) 
does not underflow 
exit from loop is signal 1 by an underflow 

i := ; 

Detain := one / beta ; 

z := Detain ; 

under flo := false; 

repeat begin 

y := z ; 

z := y * y ; 



check for underflow 

if ( ( z * one = zero ) or ( abs ( z )> y 

underflo := true; 
end else begin 
i := i f"l ; 
end ; 
end until underflo ; 
k :- 1 ; 



then begin 
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determine k such that (l/beta)**k does not underflow 
first set k = 2 ** i 



for j := 1 to i do begin 

k := k + k ; 
end ; 

iexp := i + 1 ; 
mx := k 4- k ; 

if ( ibeta = 10 ) then begin 
{ 

for decimal machines only 
iexp := 2 ; 
iz := ibeta ; 

while ( k >= iz ) do begin 
iz := iz * ibeta ; 
iexp := iexp + 1 ; 
end ; 

mx := iz + iz - 1 ; 
end; 

under flo := false; 
repeat begin 
{ 

loop to construct xmin 

exit from loop is signalled by an underflow 

xmin := y ; 

y := y * betain ; 

if ( ( ( y * one ) = zero ) or ( abs ( y )> xmin ) ) 

then begin 

under flo := true; 
end else begin 
k := k + 1 ; 
end; 
end until under flo ; 
minexp := - k ; 
{ determine maxexp, xmax 

if ( ( mx <= k + k - 3 ) and ( ibeta <> 10 ) ) then begin 

mx := mx + mx ; 

iexp := iexp + 1 ; 
end; 

maxexp := mx + minexp ; 
{ adjust for machines with implicit leading 
bit in binary significand and machines with 
radix point at extreme right of significand 

i := maxexp + minexp ; 

if ( ( ibeta = 2 ) and ( i = ) ) then maxexp := maxexp - 1 

if ( i > 20 ) then maxexp := maxexp - 3 ; 

xmax := one - epsneg ; 

if ( xmax * one <> xmax ) then xmax := one - beta * epsneg ; 

xmax := ( xmax * betain * betain * betain ) / xmin ; 

i := maxexp + minexp + 3 ; 

if ( i > ) then begin 

for j := 1 to i do begin 
xmax := xmax * beta ; 
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end; 



end ; 



end; 



function random : real ; 

{ random number generator - based on algorithm 266 
by Pike and Hill (modified by Hansson) 
collected Alg. from CACM. 

This subprogram is intended for use on computers with 
fixed point wordlength of at least 29 bits, it is 
best if the floating point significand has at most 
29 bits. } 

{ The quality of the random numbers is not important. 

If recoding is needed for small wordlength computers, 
even returning a constant value or zero is possible. } 

{ The value iy is global, and is initialized in the driver } 

begin 

iy := (iy*125) mod 2796203; 

random := ( iy )/ 2796203. OeO ; 
end; 



procedure printtestrun (n: integer; lb,ub:real; 
big, small : integer; 

mean ,maxerror ,xmaxer ror , rmserror : real) ; 
begin 

writelnC ':5,n:4,' RANDOM ARGUMENTS WERE TESTED FROM THE INTERVAL') 

writelnC ' :10, * {' ,1b: 15, • ,' ,ub:15, ' ) •) ; 

writeln; 

writelnC ':5,'THE RESULT WAS TOO LARGE* , big: 5, ' TIMES, AND'); 

writelnC ':10,'TOO SMALL* , small: 5, ' TIMES'); 

writeln; 

if (mean <> 0.0) then begin 

writelnC ':5,'MEAN RELATIVE ERROR =' ,mean:15, »=* , 
IBETA:4,' ** » ,LN (ABS (mean) )/ALBETA: 7:2) ; 
end; 
if (maxerrorO 0.0) then begin 

writelnC *:5, f THE MAXIMUM RELATIVE ERROR OF' ,maxerror :15, '=' , 
IBETA:4,' ** ' ,LN (ABS (maxerror) ) /ALBETA:7:2) ; 

writelnC *: 10, 'OCCURRED FCR X =' ,xmaxerror:15) ; 
end; 
if (rmserror <> 0.0) then begin 

writelnC ' : 5, 'ROOT-MEAN-SQUARE RELATIVE ERROR = ' , rmserror: 15, 
'=',IBETA:4,' ** ' ,LN (ABS (rmserror) ) /ALBETA: 7: 2) ; 
end; 

writeln; 
end; { OF PRINT TEST RUN } 

function sign(al , a2 : real) : real; 
begin 

if (a2 < 0) then 
sign := -abs(al) 

else 
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sign := abs(al) 



end; 



begin 

iy := 100001; 

machar ( ibeta , it , irnd , ngrd , machep , negep , iexp , minexp 

maxexp , eps , epsneg , xmin , xmax ) ; 
beta := ( ibeta ) ; 
albeta := In ( beta ); 
j := it div 3 ; 
a := 1.0 ; 

for i := 1 to j do begin 

a := a / beta ; 
end ; 



n := 2000 






xn := ( n 


; 




b := 1.0 + 


a ; 




a := 1.0 - 


a ; 




d := 1.0 + 


sqrt ( 


eps 


half := 0.! 


3 ; 




eight := 8 


.0 ; 




tenth := 


l ; 




il := ; 







random argument accuracy tests 

for j := 1 to 4 do begin 
case j of 
1: 

begin 

writeC TEST OF LN(X) VS TAYLOR SERIES EXPANSION'); 
writelnC OF LN(1+Y)'); 
end; 
2: 

begin 

writelnC TEST OF LN(X) VS LN(17X/16)-LN (17/16) ') ; 
writeln; 

a := sqrt ( half ); 
b := 15.0 / 16.0 ; 
end; 
3: 

begin 

writelnC TEST OF LN(X) VS LN(11X/10)-LN (11/10) ') ; 
writeln; 

a := sqrt ( tenth ) ; 
b := 0.9; 
end; 

begin 

writelnC TEST OF LN (X*X) VS 2 * LN(X) 1 ); 

writeln; 

a := 16.0 ; 

b := 240.0 ; 
end; 
end; 

del := ( b - a ) / xn ; 
k := ; 
kl := ; 



4: 
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xl 


:= 0.0 


r5 


:= 0.0 


r6 


:= 0.0 


r7 


:= 0.0 



xl := a ; 

for i := 1 to n do begin 
x := del * random * d 
case j of 



+ xl ; 



1: 



begin 
y ' 

z : 
zz 
zz 
zz 
end; 

begin 
x : 

y : 
z : 
zz 
zz 
end; 

begin 
x : 

y • 

z : 
zz 
zz 
end; 

begin 
z : 
zz 
zz 

end; 



( x - 0.5 ) - half ; 

In ( x ); 
= 1.0 / 3.0 ; 
= y* ( zz-y/4.0 
= ( zz - half ) * y * 



( x + 8 
x + x / 
In ( x 

( 



,0 ) - eight 
16.0 ; 



:= In 
:= zz 



y )- 7.7746816434842581e-5 
31.0 / 512.0 ; 



= ( x + 8.0 ) - eight ; 

= x + x * tenth ; 

= In ( x )/ ln(10) ; 

:= In ( y )/ ln(10) - 3.7706015822504075e-4 

:= zz - 21.0 / 512.0 ; 



= In ( 
:= In 
:= zz 



x * x 

( x ); 
+ ZZ ; 



); 



end; 
w := ( 
z 



if 
if 
r5 



z 
= sign 



zz 

( w 
( z > 0.0 ) 
( z < 0.0 ) 



/ z ; 

r z ); 
then k : 
then kl 



= k + 1 
:= kl + 



if 



= r5 
abs 
( w > 
r6 : = 

xl : = 

end; 

r7 := r7 
xl := xl 
end ; 



+ w ; 

( w ); 

r6 ) then begin 

w ; 

x ; 



w * 

del 



W ; 



r5 := r5 / xn ; 
r7 : ~ sqrt ( r 7 / xn ) ; 
printtestrun(n,a # b r k,kl,r5 r rfi,xl ,r7) ; 
end ; 

special tests 
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writelnC THE IDENTITY LN(X) = - LN(1A) WILL BE TESTED'); 

writeln; 

writelnC X F(X) + F(1A)'); 

writeln; 

for i := 1 to 5 do begin 

x := random ; 

x := x + x + 15.0 ; 

y := 1.0 / x ; 

z := In ( x )+ In ( y ); 

writeln(x:15,z:15) ; 
end ; 

writeln; 

writelnC TEST OF SPECIAL ARGUMENTS'); 

writeln; 

x := 1.0 ; 

y := In ( x ); 

writelnC LN(l.O) = ', y:15); 

writeln; 

x :- xmin ; 

y := In ( x ); 

writelnC LN(XMIN) = LN(', x:15, ») = ', y:15); 

writeln; 

x := xmax ; 

y := In ( x ); 

writelnC LN(XMAX) = LN(', x:15 r ') = ', y:15); 

writeln; 

Test 6.6.6.2-4 checks that an error is produced 
when In is called with a negative argument. 

writelnC THIS CONCLUDES THE TESTS'); 



end. 
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{ TEST 6.6.6.2-11, CLASS =I*!PLEMENTAT IONDEF INED } 

{ This program determines some of the characteristics of the 
floating-point arithmetic system of the host machine. 
If the program fails or the printed results do not agree 
with the known data for the machine then the program 
should be checked because some of the assumptions made 
about floating-point arithmetic may be invalid for that 
machine. } 

program t6p6p6p2dll (output) ; 

{ If the results from this test are not in conformity with 
the known data for the implementation, then all copies of 
MACHAR should be replaced by an equivalent that assigns 
the appropriate values to the parameters. } 



eps , epsneg , xmax , xmin : real; 

ibeta , iexp , irnd , it , machep , rnaxexp , minexp , negep , ngrd : 
integer; 

procedure machar (var ibeta , it , irnd , ngrd , machep , negep , iexp, 
minexp , maxexp : integer ; var eps , epsneg , xmin , xmax : real ) ; 



This subroutine is intended to determine the characteristics 
of the floating-point arithmetic system that are specified 
below. The first three are determined according to an 
algorithm due to M. Malcolm, CACM 15 (1972), pp. 949-951, 
incorporating some, but not all, of the improvements 
suggested by M. Gentleman and S. Marovich, CACM 17 (1974) , 
pp. 276-277. The version given here is for single precision. 

Latest revision - October 1, 1976. 



Author 



W. J. Gody 

Argonne National Laboratory 



Revised for Pascal - R. A. Freak 

University of Tasmania 

Hobart 

Tasmania 



ibeta is the radix of the floating-point representation 

it is the number of base ibeta digits in the floating-point 

significand 
irnd = if the arithmetic chops, 

1 if the arithmetic rounds 
ngrd = if irnd=l, or if irnd=0 and only it base ibeta 

digits participate in the post normalization shift 
of the floating-point significand in multiplication 
1 if irnd=0 and more than it base ibeta digits 
participate in the post normalization shift of the 
floating-point significand in multiplication 
machep is the exponent on the smallest positive floating-point 
number eps such that 1.0+eps <> 1.0 
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negeps is the exponent on the smallest positive fl. pt. no. 

negeps such that 1.0-negeps <> 1.0, except that 

negeps is bounded below by it-3 
iexp is the number of bits (decimal places if ibeta = 10) 

reserved for the representation of the exponent of 

a floating-point number 
minexp is the exponent of the smallest positive fl. pt. no. 

xmin 
maxexp is the exponent of the largest finite floating-point 

number xmax 
eps is the smallest positive floating-point number such 

that 1.0+eps <> 1.0. in particular, 

eps = ibeta**machep 
epsneg is the smallest positive floating-point number such 

that 1.0-eps <> 1.0 (except that the exponent 

negeps is bounded below by it-3). in particular 

epsneg = ibeta* *negep 
xmin is the smallest positive floating-point number, in 

particular, xmin = ibeta ** minexp 
xmax is the largest finite floating-point number, in 

particular xmax = (1.0-epsneg) * ibeta ** maxexp 

note - on some machines xmax will be only the 

second, or perhaps third, largest number, being 

too small by 1 or 2 units in the last digit of 

the significand. 



i , iz , j , k , mx : integer ; 

a , b , beta , betain , betaml , one , y , z , zero : real ; 

underflo : boolean; 

begin 

irnd := 1 ; 

one := ( irnd ) ; 

a := one + one ; 

b := a ; 

zero := 0.0 ; 
{ 

determine ibeta, beta ala Malcolm 

while ( ( ( a + one ) - a ) - one = zero ) do begin 

a := a + a ; 
end ; 
while ( ( a + b ) - a = zero ) do begin 

b := b + b ; 
end ; 

ibeta := trunc ( ( a + b ) - a ); 
beta := ( ibeta ) ; 
betaml := beta - one ; 
{ 

determine irnd,ngrd,it 

if ( ( a + betaml ) - a = zero ) then irnd := ; 
it := ; 
a := one ; 
repeat begin 

it := it + 1 ; 

a := a * beta ; 
end until ( ( ( a + one ) - a ) - one <> zero ) ; 
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determine negep, epsneg 

negep := it + 3 ; 
a := one ; 

for i := 1 to negep do begin 

a := a / beta ; 
end ; 

while ( ( one - a ) - one = zero ) do begin 

a := a * beta ; 

negep := negep - 1 ; 
end ; 

negep := - negep ; 
epsneg := a ; 

determine machep, eps 

mac hep := negep ; 

while ( ( one + a ) - one = zero ) do begin 

a :- a * beta ; 

machep := machep + 1 ; 
end ; 
eps := a ; 

determine ngrd 

ngrd := ; 

if(( irnd = 0) and((( one + eps) * one - one) <> zero)) then 

ngrd i~ 1 ; 

determine iexp, minexp, xmin 

loop to determine largest i such that 

(1/beta) ** (2**(i)) 
does not underflow 
exit from loop is signal 1 by an underflow 

i := ; 

betain := one / beta ; 
z := betain ; 
underflo := false; 
repeat begin 

y := z ; 

z := y * y ; 

check for underflow 

if ( ( z * one = zero ) or ( abs ( z )> y ) ) then begin 

underflo := true; 
end else begin 

i :■= i + 1 ; 
end; 
end until underflo ; 

k := 1 ; 

determine k such th.it (1/beta) **k does not underflow 
first set k = 2 ** i 
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for j := 1 to i do begin 

k := k + k ; 
end ; 

iexp := i + 1 ; 
rnx := k + k ; 

if { ibeta = 10 ) then begin 
{ 

for decimal machines only 
iexp := 2 ; 
iz := ibeta ; 

while ( k >= iz ) do begin 
iz := iz * ibeta ; 
iexp := iexp + 1 ; 
end ; 

mx := iz + iz - 1 ; 
end; 

under flo := false; 
repeat begin 
( 

loop to construct xmin 

exit from loop is signalled by an underflow 

xmin := y ; 

y := y * Detain ; 

if ( ( ( y * one ) = zero ) or ( abs ( y }> xmin ) ) 

then begin 

underflo := true; 
end else begin 
k := k + 1 ; 
end; 
end until underflo ; 
minexp :- - k ; 
{ determine maxexp, xmax 

if ( ( mx <= k + k - 3 ) and ( ibeta <> 10 ) ) then begin 

mx := mx + mx ; 

iexp := iexp + 1 ; 
end; 

maxexp := mx + minexp ; 
{ adjust for machines with implicit leading 
bit in binary significand and machines with 
radix point at extreme right of significand 

i := maxexp + minexp ; 

if ( ( ibeta = 2 ) and ( i = ) ) then maxexp := maxexp - 1 

if ( i > 20 ) then maxexp := maxexp - 3 ; 

xmax := one - epsneg ; 

if ( xmax * one <> xmax ) then xmax := one - beta * epsneg ; 

xmax := ( xmax * Detain * Detain * Detain ) / xmin ; 

i := maxexp + minexp + 3 ; 

if ( i > ) then begin 

for j := 1 to i do begin 
xmax := xmax * beta ; 
end ; 
end; 

snd; 



00744000 
00744100 
00744200 
00744300 
00744400 
00744500 
00744500 
00744700 
00744800 
00744900 
00745000 
00745100 
00745200 
00745300 
00745400 
00745500 
00745600 
00745700 
00745800 
00745900 
00746000 
00746100 
00746200 
00746300 
00746400 
00746500 
00746600 
00746700 
00746800 
00746900 
00747000 
00747100 
00747200 
00747300 
00747400 
00747500 
00747600 
00747700 
00747800 
00747900 
00748000 
00748100 
00748200 
00748300 
00748400 
00748500 
00748600 
00748700 
00748800 
00748900 
00749000 
00749100 
00749200 
00749300 
00749400 
00749500 
00749600 
00749700 
00749800 
00749900 
00750000 



begin 
mac 

wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
wri 
end. 



har { 

maxexp 

teln(' 

teln; 

teln; 

teln(' 

teln; 

telnC 

teln; 

telnC 

teln; 

telnC 

teln; 

telnC 

teln; 

telnC 

teln; 

telnC 

teln; 

telnC 

teln; 

teln(« 

teln; 

telnC 

teln; 

teln(* 

teln; 

telnC 

teln; 

telnC 



ibeta , it , irnd , ngrd , machep 
, eps , epsneg , xmin , xmax ) ; 
OUTPUT FROM MACHAR*); 



BETA =\ibeta:5); 
T =',it:5); 
RND =\irnd:5); 
NGRD =' f ngrd:5); 
MACHEP =*, machep: 5) ; 
NEGEP =',negep:5); 
IEXP =',iexp:5); 
MINEXP =' ,minexp:5); 
MAXEXP =', maxexp: 5) ; 
EPS =',eps:15); 
EPSNEG =', epsneg: 15); 
XMIN = , r xmin:15); 
XMAX =' f xmax:15); 



negep , iexp , minexp 



00750100 
00750200 
00750300 
00750400 
00750500 
00750600 
00750700 
00750800 
00750900 
00751000 
00751100 
00751200 
00751300 
00751400 
00751500 
00751600 
00751700 
00751800 
00751900 
00752000 
00752100 
00752200 
00752300 
00752400 
00752500 
00752600 
00752700 
00752800 
00752900 
00753000 
00753100 
00753200 
00753300 



> 
GO 
O 



CO 

=tfc 



O 
O 



O 

CD 



yo 






CD 



O 



{TEST 6.6.6.3-1, CLASS=CONFORMANCE} 

{ This program checks the implementation of the transfer 
functions trunc and round. 
The compiler fails if the program does not compile and run. } 

program t6p6p6p3dl (output) ; 
var 

i, 

truncstatus, 

roundstatus : integer; 

j : real; 
begin 

truncstatus :=0; 

round status : =0 ; 

if (trunc(3.7)=3) and (trunc (-3. 7) =-3) then 
truncstatus :=truncstatus+l 

else 

writelnC FAIL... 6. 6. 6. 3-1 : TRUNC); 

if (round(3.7)=4) and (round (-3. 7) =-4) then 

roundstatus : =roundstatus+l 
else 

writelnC FAIL... 6. 6. 6. 3-1 : ROUND'); 

j:=0; 

for i:=-333 to 333 do 

begin 

j:=j+i div 100; 
if j<0 then 

if ( trunc ( j-0.5) = round( j) ) then 
begin 

truncstatus : =truncstatus+l ; 
roundstatus : =roundstatus+l 
end 
else 

writelnC FAIL. . .6.6.6.3-1 : TRUNC ROUND') 
else 

if (trunc(j+0.5)=round(j)) then 
begin 

truncstatus : =tr uncstatus+1 ; 
roundstatus : =roundstatus+l 
end 
else 

writelnC FAIL. . .6.6.6.3-1 : TRUNC ROUND') 
end; 



end. 



if (truncstatus=668) and (roundstatus=668) then 
writelnC PASS. . .6.6.6.3-1 ') 
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{TEST 6.6.6.3-2, CLASS=ERRORHANDLING } 

{ This program causes an error to occur as the result 
returned by the trunc function is not a value of the 
type integer. 
The error should be detected at run-time. } 

program t6p6p6p3d2 (output) ; 
var 

reel : real; 
i : integer; 
ok : boolean; 
begin 

reel:=lllll. 11111; 
ok := true; 
while ok do 
begin 

i:=trunc(reel) ; 
if (i<0) then 

ok:=false 
else 

reel := reel *2 
end; 

writelnC ERROR NOT DETECTED.. .6.6.6. 3-2') 
end. 



{TEST 6.6.6.3-3, CLASS =ERRORHANDL ING } 

{ This program causes an error to occur as the result 
returned by the round function is not a value of the 
type integer. 
The error should be detected at run-time. } 

program t6p6p6p3d3 (output) ; 
var 

reel : real; 
i : integer; 
ok : boolean; 
begin 

reel:=lllll. 11111; 
ok:=true; 
while ok do 
begin 

i :=round(reel) ; 
if (i<0) then 

ok:=false 
else 

reel :=reel*2 
end; 

writelnC ERROR NOT DETECTED.. .6.6.6. 3-3') 
end. 
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{TEST 6.6.6.3-4, CLASS=DEVIANCE} 00763400 

00763500 

{ This test checks that neither trunc nor round are permitted 00763600 

to have integer parameters. The Standard requires these to be 00763700 

real. The compiler deviates if the program compiles and prints 00763800 

DEVIATES. } 00763900 

00764000 

program t6p6p6p3d4 (output) ; 00764100 

v ar 00764200 

i: integer; 00764300 

xrreal; 00764400 

begin 00764500 

i:=1979; 00764600 

x :=tr unc ( i) +round ( i+1 ) ; 00764700 

writelnC DEVIATES. . .6.6.6.3-4, TRUNC/ROUND ' ) 00764800 

end. 00764900 



{TEST 6.6.6.4-1, CLASS=CQNFORMANCE} 

{This program checks that the implementation of the ord 
function is as described by the Standard. 
The compiler fails if the program does not compile and run. } 

program t6p6p6p4dl (output) ; 
type 

colourtype = { red, orange, yellow,green, blue) ; 
var 

colour : colourtype; 

some : orange.. green; 

i : integer; 

counter : integer; 

ok : boolean; 
begin 

counter :=0; 

if (ord(false)=0) and (ord(true)=l) then 
counter : =counter+l 

else 

writelnC FAIL. . .6.6.6.4-1 : FALSE/TRUE')? 

if (ord ( red) =0) and (ord (orange) =1) and 

(ord (yellow) =2) and (ord (green) =3) and 

(ord (blue) =4) then 

co un t e r : =co un te r+ 1 
else 

writelnC FAIL. . .6.6.6.4-1 : COLOURTYPE*); 

i:— 11; 
ok:=true; 
while ok do 
begin 

i:=i+l; 
if i>10 then 
ok:=false 
else 

if ord(i)=i then 

counter :=counter+l 
else 
begin 

ok:=false; 

writelnC FAIL. . .6.6.6.4-1 : V) 
end 
end; 

colour :=blue; 
some:=orange; 
if ord (colour) =4 then 

counter : =counter+l 
else 

writelnC FAIL. . .6.6.6.4-1 : COLOUR'); 

if ord (some) =1 then 

counter : =counter+l 
else 

writelnC FAIL. . .6.6.6.4-1 : SOME*); 

if counter=25 then 

writelnC PASS. . .6.6.6.4-1') 
end. 
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{TEST 6.6.6.4-2, CLASS=CONFORMANCE} 

{ This program checks the implementation of chr. 
The compiler fails if the program does not compile and run. } 

program t6p6p6p4d2 (output) ; 
var 

letter : char; 

counter : integer; 
begin 

counter :=0; 

for letter :='0' to '9' do 

if chr (ord( letter) )=letter then 
counter : ^counter+l ; 

if counter=10 then 

writelnC PASS. . .6.6.6.4-2') 
else 

writelnC FAIL... 6. 6. 6. 4-2') 
end. 



{TEST 6.6.6.4-3, CLASS=CONFORMANCE} 

{ This program tests the function pred only. The user is 
refered to tests 6.4.2.2-4 and 6.4.2.3-2 for tests of 
succ. 
The compiler fails if the program does not compile and run. } 

program t6p6p6p4d3 (output) ; 
type 

colourtype = ( red, orange, yellow,green, blue) ; 
var 

colour : colourtype; 

counter: integer; 
begin 

counter :=0; 

colour :=blue; 

colour :=pred (colour) ; 

colour :=pred (colour) ; 

colour :=pred (succ (colour) ) ; 

if colour=yellow then 
counter :=1 

else 

writelnC FAIL.. .6.6.6.4-3 : COLOUR'); 



if pred (-10) =-11 then 

counter : =counter+l 
else 

writelnC FAIL.. .6.6.6.4-3 



-VE NUMBERS'); 



if counter=2 then 

writelnC PASS. . .6.6.6.4-3') 
end. 
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{TEST 6.6.6.4-4, CLASS=ERRORHANDLING} 

{ This program causes an error to occur as the 
function succ is applied to the last value 
of an ordinal type. 

The error should be detected by the compiler 
or at run-time. } 

program t6p6p6p4d4 (output) ; 
type 

enumerated = (f irst, second, third, last) ; 
var 

ordinal : enumerated; 
begin 

ordinal :=succ(last) ; 

writelnC ERROR NOT DETECTED. . .6.6.6.4-4 ') 
end. 



{TEST 6.6.6.4-5, CLASS=ERRORHANDLING } 

{ This program causes an error to occur as the function PRED 
is applied to the first value of an ordinal type. 
The error should be detected by the compiler or at run-time. } 

program t6p6p6p4d5 (output) ; 
type 

enumerated = (first, second, third, fourth, last) ; 
var 

ordinal : enumerated; 
begin 

ordinal :=f irst; 

ordinal :=pred (ordinal); 

writelnC ERROR NOT DETECTED. ..6.6.6.4-5, PRED') 
end. 



{TEST 6.6.6.4-6, CLASS=DEVTANCE} 

{ This test checks that succ and pred cannot be applied to 
real values. The compiler deviates if the program compiler 
and prints DEVIATES. } 

program t6p6p6p4d6 (output) ; 
var 

x:real; 
begin 

x:=0.3; 

if (succ(x)>x) and (pred(x)<x) then 

writelnC DEVIATES. . .6.6.6.4-6, REAL SUCC/PRED') 

else 

writelnC DEVIATES. . .6.6.6.4-6, MESS') 
end. 
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{TEST 6.6,6.4-7, CLASS=ERRORHANDLING } 

{ This test evokes an error by pushing chr past the 

limits of the char type. It assumes that no char type has more 
than lOOOO+ordCO 1 ) values. ] 

program t6p6p6p4d7 (output) ; 
var 

i :0.. 10000; 

c:char; 
begin 

for i:=0 to 10000 do 
c:=chr(i+ordC0')); 

writelnC ERROR NOT DETECTED. . .6.6.6.4-7, CHR') 
end. 
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{TEST -.6.6.5-3, CLASS=DEVIANCE} 

{ This test checks that the function odd is restricted to 

integer parameters. Ths compiler deviates if the program compiles 
and prints DEVIATES. } 

program t6p6p6p 5d 3 (output) ; 
var 

x:real; 
begin 

x:=1.0; 

if odd(x) then 

writelnC DEVIATES. . .6.6.6.5-3, REAL ODD') 

else 

writelnC DEVIATES. . .6.6.6.5-3, MESS') 
end. 
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{TEST 6.6.6.5-1, CLASS CONFORMANCE} 

{ This program would have tested the function of the eof and eoln 
predicates. However, the test is carried out elsewhere, and 
the user is refered to tests 6.4.3.5-2 and 6.4.3.5-3. } 

program t6p6p6p5dl; 

begin 

end. 



{TEST 6.6.6.5-2, CLASS=CONFCRMANCE} 

{ This program tests the predicate odd. 
The compiler fails if the program does not compile or 
the program states that this is so. } 

program t6p6p6p5d2 (output) ; 
var 

i, counter : integer; 
function myodd( i : integer) : boo lean; 
begin 

myodd := (abs(i mod 2) = 1); 
end; 
begin 

counter :=0; 
for i:=-10 to 10 do 
if odd(i) then 
begin 

if myodd (i) then counter := counter* 1 
end else begin 

if not myodd (i) then counter := counter* 1 
end; 
if counter=21 then 

writelnC PASS. . .6.6.6.5-2') 
else 

writelnC FAIL. . .6.6.6.5-2') 
end. 
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{TEST 6.7.1-1, CLASS=CONFORMANCE} 

{ This program tests that the precedence of the boolean operators 
is as described in the Pascal Standard. 

The compiler fails if the program does not compile, or the 
program states that this is so. } 

program t6p7pldl (output) ; 
var 

a, b, c, w, x : boolean; 
counter: integer; 
begin 

counter := 0; 
for a := false to true do 
for b:= false to true do 
for c := false to true do 
begin 

w := (a and b) < c; 
x := c > b and a; 

if (w=x) then counter := counter+1; 
end; 
if (counter=8) then 

writelnC PASS. . .6.7.1-1') 
else 

writelnC FAIL. . .6.7.1-1') 
end. 
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{TEST 6.7.1-2, CLASS=CONFORMANCE} 

{ This program tests that the precedence of the arithmetic 
operators is as described by the Pascal Standard. 
The compiler fails if the program does not compile, or 
the program states that this is so. } 

program t6p7pld2 (output) ; 
var 

a,b,c,d,e,f ,g : integer; 

h,i,j ,k,l,m,n : real; 
begin 

a:=l; 

b:=2; 

c:=3; 

d:=4; 

e:=5; 

f :=a-b+c-d; 

g:=e-d div b*c; 

h:=l; 

i:=2; 

j:=3; 

k:=4; 

1:=5; 

m:=h/i*j/k; 

n:=l+k/i-3*j; 

if (f=-2) and (g=-l) and (n=-2) and 
((itK0.38) and (irt>0.37)) then 
writelnC PASS. . .6.7.1-2') 

else 

writelnC FAIL. . .6.7.1-2') 
end. 



{TEST 6.7.2.2-1, CLASS=CONFORMANCE} 

{ This program checks the operation of the operators + - and *. 
The compiler fails if the program does not compile, or the 
program states that this is so. } 

program t6p7p2p2dl (output) ; 
var 

i/ x, y , counter : integer; 
begin 

counter := 0; 

for x := -10 to 10 do 

begin 

if (succ(x)=x+l) then 

counter := counter+1; 
if (pred(x) = x-1) then 
counter := counter+1; 
if (x*x=sqr(x)) then 
counter := counter+1; 
end; 
if (counter=63) then 

writelnC PASS. . .6.7.2.2-1 ') 
else 

writelnC FAIL. . .6.7.2.2-1') 
end. 
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{TEST 6.7.2.2-2, CLASS ^CONFORMANCE} 

{ This program checks that DIV and MOD are implemented by the 
rule specified by the Pascal Standard. 

The compiler fails if the program does not compile, or the 
program states that this is so. } 

program t6p7p2p2d2 (output) ; 
var 

i , j , counter : integer; 
begin 

counter :=0; 
for i:=0 to 6 do 
for j:=l to 4 do 

if ((i-j)<((i <3iv j)*j)) and (((i div j)*j)<=i) then 
counter : =counter+l ; 
for i:=0 to 6 do 
for j:=l to 4 do 

if (i mod j) = (i-(i div j)*j) then 
counter :=counter+l; 
if counter=56 then 

writelnC PASS. . .6.7.2.2-2*) 
else 

writelnC FAIL. . .6.7.2.2-2: DIV MOD') 
end. 



{TEST 6.7.2.2-3, CLASS=ERRORHANDLING} 

{ This program causes an error to occur as the second operand 
of the DIV operator is 0. 
The error should be detected at run- time. } 

program t6p7p2p2d3 (output) ; 
var 

i, j, k : integer; 
begin 

i:=6; 

j:=0; 

k:=i div j; { an error as 3=0 } 

writelnC ERROR NOT DETECTED. . .6.7.2.2-3: ZERO DIVIDE (DIV) 1 ) 
end. 
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{TEST 6,7.2.2-4, CLASS=QUALITY} 

{ This program checks that constant and variable operands for DIV 
produce the same result, and if negative operands are permitted. } 

program t6p7p2p2d4 (output) ; 
var 

i, j, k, 1, m,counter : integer; 
begin 

{ The next few statements may cause a run-time error. } 

writelnC THIS PROGRAM ATTEMPTS DIVISION WITH NEGATIVE OPERANDS'); 

counter := 0; 

j:=2; 

for i:= -10 to 10 do 

begin 

l:=i div j; 

m: = i div 2; 

if (l=m) then counter := counter+1; 

l:=i mod j; 

m:= i mod 2; 

if (l=m) then counter := counter+1; 

if (i-i div 2 * 2 = i mod 2) then counter := counter+1; 
end; 

if counter = 63 then 
begin 

write(* DIVISION INTO NEGATIVE OPERANDS IMPLEMENTED AND '); 

wr i tel n ( * CONS ISTENT * ) ; 
end else 

writelnC INCONSISTENT DIVISION INTO NEGATIVE OPERANDS'); 
counter := 0; 
j:-2; 

for i:= -10 to 10 do 
begin 

l:=i div j; 

m:= i div (-2); 

if (l=m) then counter := counter+1; 

l:=i mod j; 

m:= i mod (-2); 

if (l=m) then counter := counter+1; 
end; 

if counter =42 then 
begin 

write(' DIVISION BY NEGATIVE OPERANDS IMPLEMENTED AND '); 

writeln( 'CONSISTENT'); 
end else 

writelnC INCONSISTENT DIVISION BY NEGATIVE OPERANDS'); 
i:=-3; 
if (i div 2 = -1) then 

writelnC QUOTIENT = TRUNC(A/B) FOR NEGATIVE OPERANDS') 
else 

writelnC QUOTIENT = TRUNC(VB-l) FOR NEGATIVE OPERANDS'); 
if (i mod 2=1) then 

writelnC M0D(A,B) LIES IN (0,B-1)') 
else 

writelnC MCD RETURNS REMAINDER OF DIV); 
end. 
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{TEST 6.7.2.2-5, CLASB=C0NF0RMANCE} 

{ This program checks that maxint satisfies the conditions laid 
down in the Pascal Standard. 

The compiler fails if the program does not compile, or does 
not print pass. } 

program t6p7p2p2d5 (output) ; 
var 

i : integer; 
begin 

i:=- (-maxint) ; 

i :=-maxint; 

if odd (maxint) then 

i:= (maxint- ((maxint div 2)+l))*2 
else 

i:= (maxint- (maxint div 2))*2; 
if i<=maxint therv 

writelnC PASS. . .6.7.2.2-5') 
else 

writelnC FAIL. . .6.7.2.2-5: MAXINT*) 
end. 



{TEST 6.7.2.2-6, CLASS=ERRORHANDLING } 

{ This program causes an error to occur as the result of a binary 
integer operation is not in the interval -> +maxint. } 

program t6p7p2p2d6 (output) ; 
var 

i : integer; 
begin 

i := (maxint- (maxint div 2))*2+2; 

writelnC ERROR NOT DETECTED. . .6.7.2.2-6') 
end. 



{TEST 6.7.2.2-7, CLASS=ERRORHANDLING } 

{ This program causes an error to occur as the result of a binary 
integer operation is not in the interval -> -maxint. } 

program t6p7p2p2d7 (output) ; 
var 

i : integer; 
begin 

i:= (-max int+ (maxint div 2))*2-2; 

writelnC ERROR NOT DETECTED. . .6.7.2.2-7') 
end. 
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{TEST 6.7.2.2-8, CIASS=ERRORHANDLING } 

{ This program causes an error to occur as the second operand 
of the MOD operator is 0. 
The error should be detected at run-time. } 

program t6p7p2p2d8 (output) ; 
var 

i, j, k : integer; 
begin 

i:=6; 

j:=0; 

k:=i mod j; {an error as j=0 } 

writelnC ERROR NOT DETECTED. . .6.7.2.2-8: MOD ZERO 1 ) 
end. 



{TEST 6.7.2.2-9, CLASS=DEVIANCE} 

{ The unary operator plus can clearly only be applied to numeric 
operands. Hence this program should fail to compile. 
The compiler deviates if the program compiles and prints 
DEVIATES. } 

program t6p7p2p2d9 (output) ; 
const 

capa = 'A'; 
begin 

writeln(+capa) ; 

writelnC DEVIATES. . .6.7.2.2-9, UNARY OPERATOR 1 ) 
end. 
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{TEST 6.7.2.3-1, CLASS=CONFORMANCE} 

{This test checks the operation of the boolean operators. 
The compiler fails if the program does not compile, or the 
program states that this is so. } 

program t6p7p2p3dl (output) ; 
var 

a,b,c : boolean; 

counter : integer; 
begin 

counter :=0; 

a:=false; 

b:=false; 

{ OR truth table } 

if a or b then 

writelnC FAIL.. .6.7.2.3-1: OR') 
else 
begin 

b:=true; 

if a or b then 

begin 

a:=true; 

b:=false; 

if a or b then 

begin 

b:=true; 

if a or b then 

counter : =counter+l 
else 

writelnC FAIL. . .6.7.2.3-1: OR 1 ) 
end 
else 

writelnC FAIL. ..6.7.2.3-1: OR') 
end 
else 

writelnC FAIL.. .6.7.2.3-1: CR 1 ) 
end; 

{ AND truth table } 

a:=false; 

b:=false; 

if a and b then 

writelnC FAIL.. .6.7.2.3-1: AND') 
else 
begin 

b:=true; 

if a and b then 

writelnC FAIL.. .6.7.2.3-1: AND 1 ) 
else 
begin 

a:=true; 

b:=false; 

if a and b then 

writelnC FAIL. ..6. *. . ?. J-l: AND') 
else 
begin 

b:=true; 

if a and b then 

counter :=counter+l 
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else 

writelnC FAIL... 6. 7. 2. 3-1: AND') 



end. 



end 
end; 

{ NOTE: NOT is sometimes badly implemented by wordwise 

complementation, and for this reason the following 
two tests may fail. } 

if (not false) =true then 

counter : =counter+l 
else 

writelnC FAIL.. .6.7.2.3-1: NOT FALSE'); 

if (not true) = false then 

counter :=counter+l 
else 

writelnC FAIL.. .6.7.2.3-1: NOT TRUE'); 

c:=false; 

a:=true; 

b:=false; 

if (a or b) = (b or a) then 

counter : =counter+l 
else 

writelnC FAIL.. .6.7.2.3-1: COMMUTATION'); 

if ((a or b)or c) = (a or(b or c) ) then 

counter :=counter+l 
else 

writelnC FAIL.. .6.7.2.3-1: ASSOCIATIVITY'); 

if (a and(b or c)) = ((a and b)or(a and c) ) then 

counter : =counter+l 
else 

writelnC FAIL... 6. 7. 2. 3-1: DISTRIBUTION') ; 

if not (a or b) = ((not a) and (not b) ) then 

counter : =counter+l 
else 

writelnC FAIL... 6. 7. 2. 3-1: DEM0RGAN1'); 

if not (a and b) = ((not a) or (not b) ) then 

counter : =counter+l 
else 

writelnC FAIL.. .6.7.2.3-1: DEM0RGAN2'); 

if not (not a)= a then 

counter : =counter+l 
else 

writelnC FAIL.. .6.7.2.3-1: INVERSION'); 

if counter=10 then 

writelnC PASS. ..6.7.2.3-1') 
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{ TEST 6.7.2.3-2, CLASS=IMPLEMENTATIONDEF INED } 

{ This program determines if a boolean expression is partially 
evaluated if the value of the expression is determined before 
the expression is fully evaluated } 

program t6p7p2p3d2 (output) ; 
var 

a:boolean; 

k,l: integer; 
function sideef feet (var i:integer; b: boolean) .-boolean; 
begin 

i:=i+l; 

sideeffect:=b; 
end; 

begin 

writelnC TEST OF SHORT CIRCUIT EVALUATION OF (A AND B) ' ) ; 

k:=0; 

1:=0; 

a:=sideeffect(k,false) and sideef f ect ( 1, f alse) ; 

if (k=0) and (1=1) then 

writelnC SECOND EXPRESSION EVALUATED. . .6.7.2.3-2') 
else 

if (k=l) and (1=0) then 

writelnC FIRST EXPRESSION EVALUATED. . .6.7.2.3-2') 
else 

if(k=l) and (1=1) then 

writelnC BOTH EXPRESSIONS EVALUATED. . .6.7.2.3-2' ) 
else 

writelnC FAIL. . .6.7.2. 3-2'); 
end. 
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{TEST 6.7.2.3-3, CLASS=IMPLEMENTATIONDEFINED} 

{ This program determines if a boolean expression is partially 
evaluated if the value of the expression is determined before 
the expression is fully evaluated } 

program t6p7p2p3d3 (output) ; 
var 

arboolean; 

k,l:integer; 

function sideeffect(var irinteger; brboolean) : boolean ; 
begin 

i:=i+l; 

sideeffect:=b; 
end; 

begin 

writelnC TEST OF SHORT CIRCUIT EVALUATION OF (A OR B) ■ ) ; 

k:=0; 

1:=0; 

a:=sideeffect(k,true) or sideef feet (1, true) ; 

if (k=0) and (1=1) then 

writelnC SECOND EXPRESSION EVALUATED. . .6.7.2.3-3') 
else 

if (k=l) and (1=0) then 

writelnC FIRST EXPRESSION EVALUATED. . .6.7.2.3-3') 
else 

if(k=l) and (1=1) then 

writelnC BOTH EXPRESSIONS EVALUATED. . .6.7.2.3-3') 
else 

writelnC FAIL. . .6.7.2.3-3') ; 
end. 



{TEST 6.7.2.3-4, CLASS=DEVIANCE} 

{ Are logical operators allowed to be performed on integers? 
The compiler deviates if the program compiles and prints 
DEVIATES. } 

program t6p7p2p3d4 (output) ; 
var 

i,j: integer; 
beg 

:=1; j:=2; 

:=i and j; 

:=i and 1; 

:= i or j; 

:=i or j; 

:= not j; 
writelnC DEVIATES. . .6.7.2.3-4, LOGICAL OPS .» ) 
end. 
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{TEST 6.7.2.4-1, CLASS=ERRORHANDLING } 




00833500 








00833600 


O 


{ This test checks that operations on 


overlapping sets are detected. 


00833700 


y> 


An error should be detected by 


the compiler or produced 


00833800 


i — 


at run time. } 






00833900 
00834000 


m 


program t6p7p2p4dl (output) ; 






00834100 




var 
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a,d : set of 0..10; 
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b,c : set of 5.. 15; 
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begin 
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b:=[5,10]; 
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a:=[0, 5,10]; 






00834700 




d:=a+b; {ok} 
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{TEST 6.7.2.4-2, CLASS=CONFORMANCE} 
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a,b,c,d:set of 0..10; 
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counter : integer ; 






00836200 


O 


begin 
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counter :=0; 
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a:=[0,2,4,6,8,10J; 
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b:=[l, 3,5,7,9]; 
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if (d*b=b) then 
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if(d*b-b=c) then 
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counter :=counter+l; 
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if (a+b+c=d) then 
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counter :=counter+l; 
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SET 
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{TEST 6.7.2.4-3, CLASS=CONFCRMANCE} 00838400 

00838500 

{ This program checks the operations of set operators on sets 00838600 

of constants and variables. Ttie compiler fails if the program 00838700 

does not compile or the program states that this is so. } 00838800 

00838900 

program t6p7p2p4d3 (output) ; 00839000 

var 00839100 

a,b,c:set of 0..10; 00839200 

counter: integer; 00839300 

begin 00839400 

counter :=0; 00839500 

a:=[0, 2,4,6,8,10]; 00839600 

b:=[l,3,5,7,9]; 00839700 

c:=[0, 1,2, 3,4, 5,6,7,8,9, 10]; 00839800 

if(a+[]=a) then 00839900 

counter :=counter+l; 00840000 

if(a+b=c) then 00840100 

counter :=counter+l; 00840200 

if(a+[l,3,5,7,9]=c) then 00840300 

counter :=counter+l; 00840400 

if(a-[]=a) then 00840500 

counter :=counter+l; 00840600 

if(c-a=b) then 00840700 

counter :=counter+l; 00840800 

if(c-[0,2,4,6,8,10]=b) then 00840900 

counter :=counter+l; 00841000 

if(a*a=a) then 00841100 

counter :=counter+l; 00841200 

if(a*[]=[]) then 00841300 

counter :=counter+l; 00841400 

if(a*b=[]) then 00841500 

counter :=counter+l; 00841600 

if(a*c=a) then 00841700 

counter :=counter+l; 00841800 

if(counter=10) then 00841900 

writelnC PASS. . .6.7.2.4-3 SET OPERATORS') 00842000 

else 00842100 

writeln('FAIL...6.7.2.4-3 SET OPERATORS'); 00842200 

end. 00842300 



(TEST 6.7.2.5-1, CLASS=CONFCRMANCE} 

{ This program tests the use of relational operators on strings. 
The operators denote lexicographic ordering according to the 
ordering of the character set. 

The compiler fails if the program does not compile, or the 
program states that this is so. } 

program t6p7p2p5dl (output) ; 
type 

string=packed array[1..7] of char; 
var 

string!, 

string? : string; 
begin 

stringl:='STRINGl'; 

string2:='STRING2'; 

if (stringl<>string2) and (str ingl<string2) then 

begin 

stringl:=* STRINGS'; 
string2: = 'STRINGZ'; 
if (stringlOstring2) and (stringl<string2) then 

writelnC PASS. . .6.7.2.5-1') 
else 

writelnC FAIL. . .6.7.2.5-1') 
end 
else 

writelnC FAIL. . .6.7.2.5-1') 
end. 
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{TEST 6.7.2.5-2, CLASS=CONFORMANCE} 

{ This test checks the use of relational operators on sets. 
The compiler fails if the program does not compile, or the 
program states that this is so. } 

program t6p7p2p5d2 (output) ; 
var 

a,b:set of 0..10; 
c , counter : integer ; 
begin 

counter :=0; 

a: = [0, 1,2, 3,4,5]; 

b:=[2,3,4]; 

c:=3; 

if(a=[0,l,2,3,4,5]) then 

counter :=counter+l; 
if(aOb) then 

counter : =counter+l ; 
if(b<>[l,2,3,4,5]) then 

counter : =counter+l ; 
if(b<=a) then 

co un te r : =co un t e r+ 1 ; 
if(a>=b) then 

counter : =counter+l ; 
if([0,l]<=a) then 

counter :=counter+l; 
if([l,2,3,4,5,6,10]>=b) then 

counter : =counter+l ; 
if (1 in a) then 

counter :=counter+l; 
if(c in b) then 

counter :=counter+l; 
if (counter=9) then 

writelnC PASS. . .6.7.2.5-2 SET RELATIONAL OPERATORS') 
else 

writeln(» FAIL.. .6.7.2.5-2 SET RELATIONAL OPERATORS'); 
end. 
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{TEST 6.7.2.5-4, CLASS=DEVIANCE} 

{ Are relational operators permitted to concatenate? 
The compiler deviates if the program compiles and 
prints DEVIATES. } 

program t6p7p2p5d4 (output) ; 
var 

x,y,z:integer; 
b: boolean; 
begin 

x:=lj 

y:=2; 

z:=3; 

b:=(x<y<z); 

writeln(* DEVIATES. . .6.7.2.5-4, REL. OPS. ') 
end. 
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{TEST 6.7.2.5-3, CLASS=DEVIANCE} 

{ This test checks that file comparisons are not allowed. 
The semantics of this situation are particularly ill-defined, 
and not within standard Pascal. The compiler deviates if the 
program compiles and prints DEVIATES. } 

program t6p7p2p5d3 (output) ; 
var 

frtext; 
begin 

rewrite(f); 

if f=output then 

writelnC FAIL1.. .6.7.2.5-3, CONTENTS COMPARED') 

else 

writelnC FAIL2. ..6.7.2.5-3, DESCRIPTORS COMPARED') 
end. 
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{TEST 6.8.2.1-1, CLASS=CONFORMANCE} 

{ Does the compiler allow all the possible empty clauses? 
The compiler fails if the program does not compile and print 
PASS. } 



program t6p8p2pldl (output) 
var 

b:boolean; 
rl : record 
xtreal; 

arinteger; {1} 
end; 
r2: record 

case b: boolean of 
true: ( 

c:real; 
d:char; {2} 
); 
false: 

(e: integer); 
end; 
begin 

b:=true; 
if b then; {4} 
if b then else; {5} 
repeat 

b:= not b; 
until b; 
while b do 
begin 

b:=not b; 
end; 

with rl do; 
rl.a:=l; 
case rl.a of 
0: b:=false; 
1: ; {9} 
2: b:=true; 
end; 

writelnC PASS 
end. 



{3} 



{6} 

{7} 
{8} 

{10} 



6.8.2.1-1, EMPTY STATEMENT 1 ); {11} 
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{TEST 6.8.2.2-1, CLASS=TMPLEMENTATIOfOEFINED} 

{ This program determines whether selection of a variable involving 
the indexing of an array occurs before or after the evaluation 
of the expression in an assignment statement. } 

program t6p8p2p2dl (output) ; 
var 

i : integer; 

a : array[1..3] of integer; 
function sideeffect(var i: integer) : integer; 
begin 

i:=i+l; 

sideeffect:=i 
end; 

begin 

writelnC TEST OF BINDING ORDER (A[Ij := EXP)'); 

i:=l; 

a[l]:=0; 

a[2]:=0; 

a[i] :=sideeffect(i); 

if a[l]=2 then 

writelnC SELECTION THEN EVALUATION. . .6.8.2.2-1') 
else 

if a[2]=2 then 

writelnC EVALUATION THEN SELECTION. . .6.8. 2. 2-1' ) 
end. 
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{TEST 6.8.2.2-2, CIASS=IMPLEMENTATIONDEFINED} 

{ This program is similar to 6.8.2.2-1, except that the 
selection of the variable involves the dereferencing of 
a pointer. } 



program t6p8p2p2d2 (output) ; 
type 

rekord= record 

a : integer; 
b : boolean; 
link : Trekord 
end; 
poynter=Trekord; 
var 

temp, ptr : poynter; 
function sideeffect(var p : 
begin 

p:=pt.link; 
sideeffect:=2; 
end; 



poynter) : integer; 



end. 



writelnC TEST OF BINDING ORDER (Pt := EXP)'); 

new(ptr) ; 

ptrT.a:=l; 

ptr?.b:=true; 

new (temp) ; 

ptrt.link:=temp; 

tempT.a:=0; 

tempt .b:=false; 

temp:=ptr; 

ptrT.a:=sideeffect(ptr) ; 

if tempt .a=2 then 

writelnC SELECTION THEN EVALUATION. . .6.8.2.2-2') 
else 

if tempt. linkt.a=2 then 

writeln(* EVALUATION THEN SELECTION. . .6.8.2. 2-2') 
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{TEST 6.8.2.4-1, CLASS ^CONFORMANCE} 

{ This test checks that non-local goto statements are allowed } 

program t6p8p2p4dl (output) ; 

label 1; 

var 

b:boolean; 
procedure q; 
begin 

b:=true; 

goto 1; 
end; {of q} 

begin {main} 

q; 

b:=false; 
1: if b then 

writelnC PASS. . .6.8.2.4-1 NON-LOCAL GOTO') 
else 

writelnC FAIL. . .6.8.2.4-1 NON-LOCAL GOTO *) ; 
end. 



{TEST 6.8.2.4-2, CLASS=DEVTANCE} 

{ This test checks whether jumps between branches of an if 
statement are allowed. 

The compiler deviates if the program compiles and the 
program prints DEVIATES. } 

program t6p8p2p4d2 (output) ; 
label 

lr2; 
var 

i: integer; 
begin 
i:=5; 
if (i<10) then 

goto 1 
else 

l:writelnC DEVIATES. . .6.8.2.4-2') ; 
if (i>10) then 

2: writelnC DEVIATES. . .6.8. 2.4-2' ) 
else 
goto 2; 
end. 
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{TEST 6.8.2.4-3, CLASS=DE VTATES } 

{ This test checks whether jumps between branches of a 
case statement are allowed. The compiler deviates if the 
program compiles and the program prints DEVIATES. } 

program t6p8p2p4d3 (output) ; 
label 
4; 
var 

i:1..3; 
begin 

for i:=l to 2 do 
case i of 
1: ; 

2: goto 4; 
3:4: 

writelnC DEVIATES. . .6.8. 2.4-3'); 
end; 
end. 
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{TEST 6.8.2.4-4,CLASS=DEVTANCE} 

{ This test checks that a goto statement causes an error 
when the statement (S) to which control is transferred is 
not activated either by S or a statement in the statement 
sequence of which S is an immediate constituent. 
The compiler deviates if the compiler prints DEVIATES. } 

program t6p8p2p4d4 (output) ; 
var 

flag:boolean; 

procedure a(i:integer;b:boolean) ; 
label 99; 

procedure r; 
begin 

goto 99; 
end; 
begin 

case i of 

0:99: if (b) then 

writelnC DEVIATES. ..6.8.2.4-4 *) 
else 

if flag then 

writelnC PASS. . .6.8.2.4-4 ') 
else begin 

flag := true; 
a (1, false) ; 
end; 



1 
2 
end 



a(2,true); 
r; 



end; 



begin 

flag := false; 

a (0, false) ; 
end. 
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{TEST 6.8.3.4-1 CLASS CONFORMANCE} 

{ This test checks a nested if statement whose syntax is apparently 
ambiguous. The compiler fails if the program does not compile 
or the program states this by writing FAIL. } 

program t6p8p3p4dl (output) ; 
const 

off=false; 
var 

b: boolean; 
begin 

for b:=false to true do 
begin 
if b then 

if off then 

writelnC FAIL. . .6.8.3.4-1') 
else 
begin 
if not b then 

writelnC FAIL. . .6.8.3.4-1') 
else 

writelnC PASS. . .6.8.3.4-1') ; 
end; 
end; 
end. 



{TEST 6.8.3.5-1, CLASS=CONFCRMANCE} 

{ This test checks that a minimal case statement will compile. 
The compiler fails if the program does not compile. } 

program t6p8p3p5dl (output) ; 
var 

i: integer; 
begin 

i:=l; 

case i of 

1: 

end; 

writelnC PASS. . .6.8.3.5-1, CASE'); 
end. 
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{ could give a warning } 



{TEST 6.8.3.5-2, CLASS=QUALITY } 

{ This test checks that the case constants are of the same type 
as the case index. A compiler of good quality will detect that 
one path of the case statement cannot be taken and issue a 
warning message. 

The case-index in this test is a subrange and the case-constants 
are of the base type of the subrange. } 

program t6p8p3p5d2 (output) ; 
type 

day= (mon ,tue ,wed) ; 
var 

arinteger; 
d:mon..tue; 
begin 

for d:=mon to tue do 
case d of 
mon: a:=l; 
tue: a: =2; 
wed: a: =3; 
end; 
writelnC QUALITY TEST - WARNINGS FOR IMPOSSIBLE CASES'); 
writelnC PASS. . .6.8.3.5-2, CASE CONSTANTS ') ; 
end. 



{TEST 6.8.3.5-3, CLASS^DEVIANCE} 

{ This test checks that the constants of a case statement 
cannot be strings. The compiler deviates if the program 
compiles and prints DEVIATES. } 

program t6p8p3p5d3 (output) ; 
var 

a:char; 
i: integer; 
begin 

a' to 'd 

of 
i:=l; 
i:=i+l; 
i:=i+l; 
i:=i+l: 



do 



for a:-- 

case 

'a': 

'b' 

'c': 

'de* 

end; 
writelnC DEVIATES. . .6.8.3.5-3, CASE'); 
end. 
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{TEST 6.8.3.5-4, CLASS CONFORMANCE} 00882500 

00882600 

{ This test checks that a compiler handles a sparse case adequately 00882700 

Most compilers issue a jump table for a case, regardless 00882800 

of its structure. It is easy to optimise case statements 00882900 

to generate conditional statements if this is more compact. 00883000 

The compiler fails if the program does not compile 00883100 

or the program fails in execution. } 00883200 

00883300 

program t6p8p3p5d4 (output) ; 00883400 

var 00883500 

i,j: integer; 00883600 

begin 00883700 

i:=-1000; 00883800 

for j:=l to 2 do 00883900 

case i of 00884000 

-1000: i:=-i; 00884100 

1000: writelnC PASS. . .6.8. 3.5-4, SPARSE CASE 1 ); 00884200 

end; 00884300 

end. 00884400 



{TEST 6.8.3.5-5, CLASS=ERRORHANDLING } 

{ This test checks the type of error produced when the case 
statement does not contain a constant of the selected value. 
An execution error should be produced. } 

program t6p8p3p5d5 (output) ; 
var 

i: integer; 
begin 

i:=0; 

case i of 

-3,3: writelnC FAIL. . .6.8. 3.5-5, CASE*); 

end; 

wr i tel n ( * ERROR NOT DETECTED. ..6.8.3.5-5, CASE CONSTANT ' ) ; 
end. 
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00884700 
00884800 
00884900 
00885000 
00885100 
00885200 
00885300 
00885400 
00885500 
00885600 
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{TEST 6.8.3.5-6, CLASS=ERRORHANDLING } 00886100 

00886200 

{ This test is similar to the previous one - a case statement 00886300 

is given without a case-constant of the selected value. This 00886400 

time the value is a long way outside the case. An error should 00886500 

be produced at execution time. } 00886600 

00886700 

program t6p8p3p5d6 (output) ; 00886800 

var 00886900 

i: integer; 00887000 

begin 00887100 

i:=1000; 00887200 

case i of 00887300 

-3,3: writelnC FAIL. . .6.8. 3.5-6, CASE 1 ); 00887400 

end; 00887500 

writelnC ERROR NOT DETECTED. . .6.8. 3.5-6, CASE CONSTANT'); 00887600 

end. 00887700 



{ TEST 6.8.3.5-7, CLASS=ERRORHANDLING } 

{ This test contains an invalid real case-constant with an integer 
case expression. If the program compiles the effect at run-time 
could be curious. } 

program t6p8p3p5d7 (output) ; 
var 

a,i :integer; 
begin 

for i:=l to 4 do 
case i of 
1,2: a:=l; 

2.5: writelnC DEVIATES. . .6.8. 3.5-7. CASE'); 
3: a:=2; 

4e0: writelnC DEVIATES. . .6.8. 3.5-7, CASE'); 
end; 
writelnC DEVIATES. . .6.8. 3.5-7, CASE'); 
end. 



3> 
00887800 GO 
00887900 O 
00888000 j> 
00888100 
00888200 ^ 
00888300 !Z3 
00888400 Zn 
00888500 
00888600 "^ 
00888700 C7> 
00888800 
00888900 
00889000 
00889100 
00889200 
00889300 
00889400 
00889500 
00889600 



O 
O 



O 
CD 



1X> 






CD 



00 



{TEST 6.8.3.5-8, CLASS =QUALITY} 

{ This test checks a large populated case statement to check the 
limit on the size of code is not a serious one. 
The compiler has a small limit on the size of the case 
statement if the program does not compile and print PASS. } 

program t6p8p3p5d8 (output) ; 
var 

sum: integer; 

i:0..255; 
begin 

sum :=0; 

for i:=0 to 255 do 
case i of 
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QUALITY TEST - SIZE OF CASE STATEMENT 1 ); 
32640 then 
n(' PASS... 6. 8. 3. 5-8') 

n(' FAIL. ..6. 8. 3. 5-8'); 



{TEST 6.8.3.5-9, CLASS=DEVIANCE} 

{ This test checks that the compiler detects that case-constants 
and the case-index are of different types. 

The compiler deviates if the program compiles and the program 
prints deviates. } 

program t6p8p3p5d9 (output) ; 
var 

i , counter : integer ; 
begin 

counter := 0; 
for i:= 1 to 4 do 
case i of 

1: counter :=counter+l; 
2.0: counter :=counter+l; 
3: counter :=counter+l ; 
4e0: counter :=counter+l; 
end; 
if counter=4 then 

writelnC DEVIATES. . .6.8.3.5-9, CASE CONSTANTS') 
else 

writelnC FAILS. . .6.8.3.5-9, CASE CONSTANTS ') ; 
end. 
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{TEST 6.8.3.5-10, CLASS=DEVTANCE} 

{ This test checks that the compiler detects real case constants 
and a real case index, even when the values are integers. 
The compiler fails if the program compiles and the program 
prints FAILS. } 

program t6p8p3p5dl0 (output) ; 
var 

i ,counter : integer; 
rrreal; 
begin 

counter := 0; 

for i:= 1 to 4 do 

begin 

r:=i; 

case r of 

1.0: counter :=counter+l; 

2.0: counter :=counter+l; 

3.0: counter :=counter+l; 

4e0: counter :=counter+l; 

end; 
end; 
if counter=4 then 

writelnC DEVIANCE. ..6.8.3.5-10, CASE CONSTANTS 1 ) 

writelnC FAILS. . .6.8.3.5-10, CASE CONSTANTS •) ; 
end. 



{TEST 6.8.3.5-11, CLASS=DEVIANCE} 

{ This test checks that the compiler detects that a case index 
and the case constants are of different types. 
The compiler deviates if the program compiles and the program 
prints DEVIATES. } 

program t6p8p3p5dll (output) ; 
var 

i , counter: integer; 
r:real; 
begin 

counter := 0; 

for i:= 1 to 4 do 

begin 

r:=i; 

case r of 

1: counter :=counter+l; 

2: counter :=counter+l; 

3: counter :=counter+l; 

4: counter :=counter+l; 

end; 
end; 
if counter=4 then 

writelnC DEVIATES. . .6.8.3.5-11, CASE CONSTANTS') 
else 

writelnC PASS. . .6.8.3.5-11, CASE CONSTANTS ') ; 
end. 
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{TEST 6.8.3.5-12, CLASS=DEVTANCE} 

{ Some processors allow subrange-like lists to be used as case- 
elements. This test checks to see if this is allowed. It is 
not standard Pascal. The compiler deviates if the program 
compiles and prints DEVIATES. } 

program t6p8p3p5dl2 (output) ; 
var 

thing:(a,b,c,d,e,f); 
begin 

thing :=a; 

while thingOf do begin 
case thing of 

a..d: thing := succ(thing); 
e: thing:=f 
end 
end; 

writelnC DEVIATES. . .6.8.3.5-12, CASE CONSTANTS ' ) 
end. 
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{TEST 6.8.3.5-13, CLASS=DEVIANCE} 00927500 

00927600 

{ Similar to test 6.8.3.5-12, this test checks the subrange 00927700 

case extension, which may not be safely implemented. This program 00927800 

is utter confused garbage and indicates the kinds of checks 00927900 

needed. The compiler deviates if the program compiles and 00928000 

prints DEVIATES. } 00928100 

00928200 

program t6p8p3p5dl3 (output) ; 00928300 

var 00928400 

t,thing:(a,b,c,d,e,f,g,h); 00928500 

begin 00928600 

for thing :=a to g do begin 00928700 

case thing of 00928800 

a..e: t:=thing; 00928900 

d..g: t:=succ( thing); 00929000 

b: t:=pred( thing) 00929100 

end 00929200 

end; 00929300 

writelnC DEVIATES. . .6.8.3.5-13, CASE CONSTANTS') 00929400 

end. 00929500 



{TEST 6.8.3.5-14, CLASS=EXTENSION, SUBCLASS=CCMFORMANCE} 

{ This test checks whether an otherwise clause in a case statement 
is accepted. The convention is that adopted at the UCSD Pascal 
workshop in July 1978. The extension is accepted if the program 
compiles and prints EXTENSION - PASS } 

program t6p8p3p5dl 4 (output) ; 
var 

i,j ,k, counter: integer; 
begin 

counter :=0; 
for i:=0 to 10 do 
case i of 
1,3,5,7,9: 

counter :=counter+l; 
otherwise 

j:=counter; 
k:=j; 
end; 
if (counter = 5) then 

writelnC EXTENSION - PASS. . .6.8. 3. 5-14, OTHERWISE') 
else 

writelnC EXTENSION - FAIL. . .6.8. 3. 5-14, OTHERWISE*); 
end. 
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{TEST 6.8.3.7-1, CLASS=CONF0RMANCE} 

{ This test checks that a repeat loop is executed at least once. 
The compiler fails if the program prints FAILS. } 

program t6p8p3p7dl (output) ; 
var 

counter: integer; 

bool : boolean; 
begin 

bool:=true; 

counter :=0; 

repeat 

counter : =counter+l 

until bool; 

if (counter=l) then 

writelnC PASS. . .6.8.3.7-1, REPEAT') 

else 

writelnC FAIL. . .6.8.3.7-1, REPEAT'); 
end. 
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{TEST 6.8.3.7-2, CLASS=CONFORMANCE} 

{ This test checks that a loop containing no statements 
is executed until the expression is true. 
The compiler fails if the program does not compile or the 
program prints FAIL. } 

program t6p8p3p7d2 (output) ; 
var 

a:integer; 

function bool : boolean; 
begin 

a:=a+l; 

bool := a>=5; 
end; 

begin 
a:=0; 
repeat 
until bool; 
if (a=5) then 

writelnC PASS. . .6.8.3.7-2, EMPTY REPEAT') 
else 

writelnC FAIL. . .6.8.3.7-2, EMPTY REPEAT') ; 
end. 



{TEST 6.8.3.7-3, CLASS=CONFORMANCE} 

{ This test decks that an apparently infinite loop is allowed 
by the compiler. Some compilers may detect the loop as being 
infinite. The compiler fails if the program does not compile. } 

program t6p8p3p7d3 (output) ; 
label 

100; 
const 

eternity = false; 
var 

i: integer; 
begin 

i:=0; 

repeat 
i:=i+l; 

if (i>50) then 
goto 100; 

until eternity; 
100: 

writeln(* PASS. . .6.8.3.7-3, REPEAT'); 
end. 
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{TEST 6.8.3.8-1, CLASS=CONFORMANCE} 

{ This test checks that a while loop is not entered 

if the initial value of the boolean expression is false. 
The compiler fails if the program prints FAIL. } 

program t6p8p3p8dl (output) ; 
var 

bool : boolean; 
counter : integer ; 
begin 

counter :=0; 
bool:=false; 
while bool do 
begin 

co un t e r : =co un t e r+1 ; 
bool:=false; 
end; 
if (counter=0) then 

writelnC PASS. . .6.8.3.8-1, WHILE') 
else 

writelnC FAIL. . .6.8.3.8-1, WHILE'); 
end. 



{TEST 6.8.3.8-2, CLASS=CONFORMANCE} 

{ This test checks that the compiler will accept a while 
loop containing no statements. The compiler fails if the 
program does not compile or the program prints FAIL. } 

program t6p8p3p8d2 (output) ; 
var 

a : integer; 

function bool:boolean; 
begin 

a:=a+l; 

bool:= (a>=5); 
end; 

begin 
a:=0; 

while not bool do ; 
if (a=5) then 

writelnC PASS. . .6.8.3.8-2, EMPTY WHILE') 
else 

writelnC FAIL. . .6.8.3.8-2, EMPTY WHILE') ; 
end. 
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{TEST 6.8.3.9-1, CLASS=CONFOFiMANCE} 

{ This program checks that assignment follows the evaluation of 
both expressions in a for statement. 
The compiler fails if the program prints FAIL. } 

program t6p8p3p9dl (output) ; 
var 

i,j : integer; 
begin 

i:=l; 

j:=0; 

for i:= (i+1) to (i+10) do 

begin 

writeln(i) ; 
end; 
if (j=10) then 

writelnC PASS. . .6.8.3.9-1, FOR') 
else 

writelnC FAIL. . .6.8.3.9-1, FOR'); 
end. 



{TEST 6.8.3.9-2, CLASS=DEVIANCE} 

{ This program checks that an assignment cannot be made to a 
for statement control variable. 

The compiler deviates if the program compiles and prints 
DEVIATES. } 

program t6p8p3p9d2 (output) ; 
var 

i ,j rinteger; 
begin 
j:=0; 

for i:=l to 10 do 
begin 

j:=j+l; 
i:=i+l; 
writeln( j,i) ; 
end; 

writelnC DEVIATES. . .6.8.3.9-2, FOR'); 
end. 



00943700 
00943800 
00943900 
00944000 
00944100 
00944200 
00944300 
00944400 
00944500 
00944600 
00944700 
00944800 
00944900 
00945000 
00945100 
00945200 
00945300 
00945400 
00945500 
00945600 
00945700 
00945800 



00945900 
00946000 
00946100 
00946200 
00946300 
00946400 
00946500 
00946600 
00946700 
00946800 
00946900 
00947000 
00947100 
00947200 
00947300 
00947400 
00947500 
00947600 
00947700 
00947800 



{TEST 6.8.3.9-3, CLASS =DE VI ANCE} 

{ This test checks that an error is produced when an 
assignment is made to a for statement control variable. 
The compiler deviates if the program compiles and prints 
DEVIATES. } 

program t6p8p3p9d3 (output) ; 
var 

i,j : integer; 

procedure nasty (var n: integer); 
begin 

n:=r*fl; 
end; 

begin 
j:=0; 

for i:=l to 10 do 
begin 

nasty (i) ; 
end; 

writelnC DEVIATES. . .6.8. 3.9-3, FOR'); 
end. 



{TEST 6.8.3.9-4, CLASS=DEVIANCE} 

{ This program tests that an error is produced when an assignment 
is made to a for statement control variable. 
The compiler deviates if the program compiles and prints 
DEVIATES. } 

program t6p8p3p9d4 (output) ; 
var 

i,j : integer; 

procedure verynasty; 
begin 

i:=i+l; 
end; 

begin 
~j:=0; 
for i:= 1 to 10 do 
begin 

verynasty; 
end; 

writelnC DEVIATES. . .6.8.3.9-4, FOR'); 
end. 
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{TEST 6.8.3.9-5, CLASS=ERRORHANDLING } 

{This test checks that the use of a for statement control 
variable after the completion of the for statement, and 
without an intervening assignment is detected. } 

program t6p8p3p9d5 (output) ; 
var 

i,j,k,m: integer; 
begin 

i:=100; 

j:=l; 

k:=10; 

m:=0; 

for i:=j to k do 

begin 

m:=m+l; 

end; 

writelnC THE VALUE OF I =',i); 

writelnC ERROR NOT DETECTED. . .6.8.3.9-5, FOR'); 
end. 
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{TEST 6.8.3.9-6, CLASS=ERRORHANDLING } 00955000 

00955100 

{ This program uses a for statement control variable after a 00955200 

for loop which is not entered. The control variable should be 00955300 

undefined after the for statement. } 00955400 

00955500 

program t6p8p3p9d6 (output) ; 00955600 

var 00955700 

i,j,k,m:integer; 00955800 

bec ^ in 00955900 

i:=10 °; 00956000 

k:=1 ; 00956100 

m:= °; 00956200 

J :=1 °? 00956300 

for i:=j to k do 00956400 

begin 00956500 

m:=m+l; 00956600 

end ; 00956700 

writelnC THE VALUE OF I =',i); 00956800 

writelnC ERROR NOT DETECTED. . .6.8.3.9-6, FOR 1 ); 00956900 

end - 00957000 



{TEST 6.8.3.9-7, CLASS=CONFORMANCE} 

{ This test checks that extreme values may be used in a for 
loop. This will break a simply implemented for loop. 
In some compilers the succ test may fail at the last increment 
and cause wraparound (overflow) - leading to an infinite loop. } 

program t5p8p3p9d7 (output) ; 
var 

i ,j : integer; 
begin 

j:=0; 

for i:= (maxint-10) to maxint do 

for i:= (-maxint+10) downto -maxint do 

j:=j+l; 
if j = 22 then 

writelnC PASS. . .6.8.3.9-7, FOR LOOP') 
else 

writelnC FAIL. . .6.8.3.9-7, FOR LOOP 1 ); 
end. 
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{TEST 6.8.3.9-8, CLASS CONFORMANCE} 00959200 

00959300 

{ This program checks that a control variable of a for statement 00959400 

is not undefined if the for statement is left via a goto 00959500 

statement. The compiler fails if the program does not compile 00959600 

or the program prints FAIL. } 00959700 

00959800 

program t6p8p3p9d8 (output) ; 00959900 

label 100; 00960000 '^j 

var 00960100 » 

i,j: integer; 00960200 ^ 

begin 00960300 ^o 

j:=l ; 00960400 

for i:=l to 10 do 00960500 

begin 00960600 

if (j=5) then 00960700 

goto 100; 00960800 

j:=j+l; 00960900 

end; 00961000 

100: 00961100 

if i=j then 00961200 

writelnC PASS. . .6.8.3.9-8, FORM 00961300 

else 00961400 

writelnC FAIL. . .6.8.3.9-8, FOR'); 00961500 

end. 00961600 
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{TEST 6.8.3.9-9, CLASS-DEVIANCE} 

{ This program tests whether a non local variable at an intermediate 
level can be used as a for statement control variable. 
The program deviates if the program compiles and prints 
DEVIATES. } 

program t6p8p3p9d9 (output) ; 

procedure p; 
var 

i: integer; 

procedure loop; 
var 

j: integer; 
begin 
j:=0; 

for i:=l to 10 do 
j:=j+l; 
end; 
begin 

loop 
end; 

begin 

P; 

writelnC DEVIATES. . .6.8.3.9-9, FOR'); 
end. 



{TEST 6.8.3.9-10, CLASS=OEVIANCE} 

{ This program tests whether a real number can be assigned to 
a for statement control variable. The compiler deviates 
if the program compiles and prints DEVIATES. } 

program t6p8p3p9dl0 (output) ; 
var 

i: integer; 
counter: integer; 
begin 

counter :=0; 

for i:=0.0 to 3.5 do 

counter : =counter+l ; 
i f ( co un te r =4 ) then 

writelnC DEVIATES. . .6.8.3.9-10, FOR EXPRESSION ROUNDED') 
else 

writelnC DEVIATES. ..6.8.3.9-10, FOR EXPRESSION TRUNCATED') ; 
end. 
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{TEST 6.8. 3. 9- LI, CLASSOEVIANCE} 

{ This test checks whether a for statement control variable 
can be a component variable. 

The compiler deviates if the program compiles and prints 
DEVIATES. } 

program t6p8p3p9dll (output) ; 
var 

rec: record 

i ,j rinteger; 
end; 
begin 

for rec.i:=0 to 10 do 

rec.j := rec.i; 
with rec do 

for i := to 10 do 
j: = i; 
writelnC DEVIATES. . .6.8.3.9-11, FOR*); 
end. 



{TEST 6.8.3.9-12, CLASS=DEVIATES} 

{ This test checks whether a for statement control variable 
can be a pointer variable. 

The compiler deviates if the program compiles and prints 
DEVIATES. } 

program t6p8p3p9dl2 (output) ; 
type 

int - finteger; 
var 

ptrrint; 

j rinteger; 
begin 

j:=0; 

new(ptr) ; 

for ptrt := to 10 do 
j:=j+l; 

writelnC DEVIATES. . .6.8.3.9-12, FOR'); 
end. 
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{TEST 6.8.3.9-13, CLASS=DEVIANCE} 

{ This program tests whether a formal parameter can be used 
as a for statement control variable. 

The program deviates if the program compiles and prints 
DEVIATES. } 

program t6p8p3p9dl3 (output) ; 

procedure p; 
var 

i: integer; 

procedure loop(var i: integer); 
var 

j: integer; 
begin 

j:=0; 

for i:=l to 10 do 
j:=j+l; 
end; 
begin 
i:=10; 
loop(i) 
end; 

begin 
P; 

writelnC DEVIATES. . .6.8.3.9-13, FOR'); 
end. 
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{TEST 6.8.3.9-14, CLASS=DEVIANCE} 

{ This program tests whether a global variable (at program level) 
can be used as a for statement control variable. 
The program deviates if the program compiles and prints 
DEVIATES. } 

program t6p8p3p9dl4 (output) ; 
var 

i:integer; 

procedure p; 

procedure loop; 
var 

j: integer; 
begin 

j:=0; 

for i:=l to 10 do 

end; 
begin 

loop 
end; 

begin 

p; 

writelnC DEVIATES. . .6.8.3.9-14, FOR'); 
end. 

{TEST 6.8.3.9-15, CLASS CONFORMANCE} 

{ This program checks the order of evaluation of the limit expressions 
in a for statement. 
The compiler fails if the program prints FAIL. } 

program t.6p8p3p9dl5 (output) ; 
var 

i ,j ,k: integer; 

function f(var krinteger) : integer; 
begin 

k:-k+l; 

f:=k; 
end; 

begin 
k:=0; 
j:=0; 

for i:=f(k) to f(k)+10 do 
begin 

writeln(i) ; 
end; 
if (j=12) then 

writelnC PASS. . .6.8. 3.9-15, FOR') 
el se 

writelnC FAIL. . .6.8. 3.9-15, FOR'); 
end. 
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{TEST 6.8.3.9-16, CLASS=DEVIANCE} 

{This test checks the type of error produced when a for statement 
control variable value is read during the execution of the for 
statement. The compiler deviates if the program compiles and 
prints DEVIATES. } 

program t6p8p3p9dl6 (output ,f) ; 
var 

f :text; 

i,j: integer; 
begin 

j:=0; 

rewrite(f); 

writeln(f, 5,5,5,5,5); 

reset ( f ) ; 

for i := 1 to 10 do 

begin 

if (i<5) then 
read(f,i); 
j:=j+l; 

end; 

writelnC DEVIATES. . .6.8.3.9-16, FOR'); 
end. 



{TEST 6.8.3.9-17, CLASS=ERRORHANDLING } 

{ This test checks the type of error produced when two nested 
for statements use the same control variable. } 

program t6p8p3p9dl 7 (output) ; 
var 

i,j: integer; 
begin 

j:=0; 

for i:=l to 10 do 
for i:=l to 10 do 
j:=j+l; 

writelnC ERROR NOT DETECTED. . .6.8.3.9-17, FOR'); 
end. 
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{TEST 6.8.3.9-18, CLASS=QUALITY} 

{ This test checks that the undefined state of a for-statement 
controlled variable when the loop is left has one or both of 
the following properties: 

(a) Range checks are not omitted on these variables in the 
supposition that its value is permissible, or 

(b) the value of the variable is in range of its type (in 
this specific implementation) . 

This test is not relevant if the use of the variable is 
prohibited. } 

program t6p8p3p9dl8 (output) ; 
type 

t= (red ,green, blue, pink) ; 
var 

i,j,k:t; 

m: integer; 
begin 

{ i is a finite scalar. } 

i:=green; 

j:=red; 

k:=pink; 

m:=0; 

for i:=j to k do 

begin 

m:=m+l; 

end; 

writelnC THE UNDEFINED ORDINAL VALUE OF I IS • ,ord(i)); 

wr i tel n (' ERROR NOT DETECTED ' ) ; 

writeC ITS SYMBOLIC VALUE IS '); 

{ A possible omission of the range check on the case statement 
may be disastrous if a wild jump occurs. } 

case i of 

red: writeln('RED') ; 
green: writelnC GREEN') ; 
blue: writelnC BLUE'); 
pink: writelnC PINK' ) ; 
end; 

writelnC JUST IN CASE THE RANGE ISNT CHECKED'); 
end. 
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{TEST 6.8.3.9-19, CLASS =DE VI ANCE} 

{ This test checks that compilers that permit the deviation 
(extension?) of allowing non-local control variables do so 
responsibly and do not introduce new insecurities. 
This test checks that a nested for statement using the same control 
variable is detected. It is similar to test 6.8.3.9-14 but 
requires a degree of sophistication to detect this condition. 
The compiler deviates if the program prints DEVIATES. 
The program may loop endlessly under some compilers. } 

program t6p8p3p9dl9 (output) ; 
var 

i: integer; 

procedure p; 
procedure q; 
procedure r; 

procedure s(var i: integer); 
begin 

writeln(i) ; 
end; 
begin 

for i:= 5 downto 2 do 
s(i); 
end; 
begin 
r 
end; 
begin 

q 

end; 

begin 

for i:= 1 to 6 do 
P; 

writelnC DEVIATES. ..6.8.3.9-19, FOR 1 ) 
end. 
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{TEST 6.8.3.9-20, CLASS=QUALITY} 00991300 

00991400 

{ This test checks that for statements may be nested to 15 levels 00991500 

The test may detect a small compiler limit, particularly 00991600 

those compilers that use a register for a control variable. } 00991700 

00991800 

program t6p8p3p9d20 (output) ; 00991900 

var 00992000 

il,i2,i3,i4,i5,i6,i7,i8,i9,il0, ill, il2,il3,il4,il5: integer; 00992100 

j: integer; 00992200 

begin 00992300 

for il:=l to 2 do 00992400 

for i2:=l to 2 do 00992500 

for i 3: =1 to 2 do 00992600 

for i4:=l to 2 do 00992700 

for i5:=l to 2 do 00992800 

for i6:=l to 2 do 00992900 

for i7:=l to 2 do 00993000 

for i8:=l to 2 do 00993100 

for i9:=l to 2 do 00993200 

for il0:=l to 2 do 00993300 

for ill:=l to 2 do 00993400 

for il2:=l to 2 do 00993500 

for il3:=l to 2 do 00993600 

for il4:=l to 2 do 00993700 

for il5:=l to 2 do 00993800 

j:=10; 00993900 

writelnC FOR STATEMENT NESTED TO > 15 LEVELS. . .6.8.3.9-20') 00994000 

end. 00994100 
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{TEST 6.8.3.10-1, CLASS CONFORMANCE} 

{ This program checks the implementation of the with statement. 
The compiler fails if the program does not compile or it 
compiles and prints FAILS. } 

program t6p8p3pl0dl (output) ; 
var 

rl: record 

a, b: integer 
end; 
r2 : record 

c,d: integer 
end; 
r3: record 

e,f : integer 
end; 
counter : integer ; 
begin 

counter :=0; 
with rl do 

a:=5; 
with rl,r2,r3 do 
begin 
e:=a; 
c:=a 
end; 

with r2 do 
if c=5 then 

counter : =counter+l ; 
if r2.c=5 then 

counter :=counter+l; 
if counter=2 then 

writelnC PASS 6.8.3.10-1, WITH') 
else 

writelnC FAIL 6.8.3.10-1, WITH'); 
end. 
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{TEST 6.8.3.10-2, CLASS=CONFOf?MANCE} 

{ This test checks that a field identifier is correctly 
identified when a with statement is invoked. 
The compiler fails if the program does not compile or the 
program prints FAILS. } 

program t6p8p3pl0d2 (output) ; 
var 

r: record 

i ,j : integer 
end; 
i: integer; 
begin 
i:=10; 
with r do 

i:=5; 
if (i=10) and (r.i=5) then 

writelnC PASS 6.8.3.10-2, WITH') 
else 

writelnC FAIL 6.8.3.10-2, WITH 1 ); 
end. 
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{TEST 6.8.3.10-3, CLASS CONFORMANCE} 

{ This test checks that the record-vari able- list is evaluated 
in the correct order. The compiler fails if the program does 
not compile or the program prints FAILS. } 

program t6p8p3pl0d3 (output) ; 
var 

rl: record 

i , j ,k: integer 
end; 
r2 : record 

i ,j : integer 
end; 
r3: record 

i: integer 
end; 
begin 

with rl do 

begin 

i:=0; 

j:=0; 

k:=0 

end; 

with r2 do 
begin 
i:=0; 
j:=0 
end; 
with r3 do 

i:=0; 
with rl,r2,r3 do 
begin 
i:=5; 

j:=6; 

k:=7 
end; 
if(rl.i=0) and (rl.j=0) and (r2.i=0) and (rl.k=7) 

and (r2.j=6) and (r3.i=5) then 

writelnC PASS 6.8.3.10-3, WITH EVALUATION*) 
else 

writelnC FAIL 6.8.3.10-3, WITH EVALUATION'); 
end. 
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{TEST 6.8.3.10-4, CLASS CONFORMANCE} 

{ This test checks that the selection of a variable in the 
record-vari able- list is performed before the component 
statement is executed. The compiler fails if the program 
does not compile or the program prints FAIL. } 

program t6p8p3pl0d4 (output) ; 
var 

a:array[l. .2] of record 

i,j: integer 
end; 
k: integer; 
begin 

a[2].i:=5; 
k:=l; 

with a[k] do 
begin 
j:=l; 
k:=2; 
i:=2 
end; 
if (a[2].i=5) and (a[l].i=2) then 

writelnC PASS. . .6.8.3.10-4, WITH 1 ) 
else 

writelnC FAIL. . .6.8.3.10-4, WITH'); 
end. 
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{TEST 6.8.3.10-5, CL?^SS=CONFORMANCE} 

{ This test checks that the selection of a variable in the 
record-variable-list is performed before the component 
statement is executed. The compiler fails if the program 
does not compile or the program prints FAIL. } 

program t6p8p3pl0d5 (output) ; 
type 

pointer = trecordtype; 
record type = record 

data: integer; 
1 ink :po inter 
end; 
var 

counter : integer ; 
p,q:pointer; 
begin 

counter :=0; 

new(p) ; 

pT.data:=0; 

new(q) ; 

qt.data:=l; 

qt.link:=nil; 

pf. link: =q; 

q:=P; 

with qt do 

begin 

q:=link; 

if (data=0) and (qT.data=l) then 
counter :=counter+l; 
end; 

with pt do 
begin 

p:=link; 

{ The first record now has no reference, so it could 

be deleted prematurely. } 
if (data=0) and (pT.data=l) then 
counter :=counter+l; 
end; 
if counter =2 then 

writelnC PASS. ..6.8.3.10-5, WITH') 
else 

writelnC FAIL. . .6.8.3.10-5, WITH*); 
end. 
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{TEST 6.8.3.10-6, CLASS=CONF0RMANCE} 

{ This test checks that the order of evaluation of the 
record-variable-list in a with statement is correctly 
implemented. The compiler fails if the program prints FAIL. } 

program t6p8p3pl0d6 (output) ; 
type 

PP = Tptr; 
ptr = record 

i: integer; 
link:pp; 
end; 
var 

P,q,r : pp; 
begin 

new(p) ; 

Pt.i := 0; 

new(q) ; 

qt.i := 0; 

pT.link := q; 

new(r); 

rT.i := 0; 

rt.link := nil; 

qt.link := r; 

with pT, linkf, linkT do 

begin 

i:=5; 
end; 
if ((rT.i=5) and (qT.i=0) and (pT.i=0)) then 

writeln(»PASS...6.8.3.10-6, WITH 1 ) 
else 

writelnC FAIL. . .6.8.3.10-6, WITH 1 ); 
end. 
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{TEST 6.8.3.10-7, CLASS=QUALITY} 

{ This test checks that with statements may be nested to 15 
levels. The test may break a compiler limit in some compilers, 
particularly if a register is allocated for every selected 
variable. } 



program 
type 
reel 



rec2 



t6p8p3pl0d7 (output) ; 

= record 

i: integer 
end; 
= record 

i: integer 
end; 
rec3 = record 

i: integer 
end; 
rec4 = record 

i: integer 
end; 
rec5 = record 

i: integer 
end; 
rec6 = record 

i: integer 
end; 
rec7 = record 

i: integer 
end; 
rec8 = record 

i: integer 
end; 
rec9 = record 

i: integer 
end; 
reclO = record 

i: integer 
end; 
recll = record 

i: integer 
end; 
reel 2 = record 

i: integer 
end; 
reel 3 = record 

i: integer 
end; 
reel 4 = record 

i: integer 
end; 
reel 5 = record 

i: integer 
end; 
pi = Trecl; 
p2 = Trec2; 
p3 = frec3; 
p4 = Trec4; 
p5 = Trec5; 
p6 = frec6; 
p7 = Trec7; 



01015000 
01015100 
01015200 
01015300 
01015400 
01015500 
01015600 
01015700 
01015800 
01015900 
01016000 
01016100 
01016200 
01016300 
01016400 
01016500 
01016600 
01016700 
01016800 
01016900 
01017000 
01017100 
01017200 
01017300 
01017400 
01017500 
01017600 
01017700 
01017800 
01017900 
01018000 
01018100 
01018200 
01018300 
01018400 
01018500 
01018600 
01018700 
01018800 
01018900 
01019000 
01019100 
01019200 
01019300 
01019400 
01019500 
01019600 
01019700 
01019800 
01019900 
01020000 
01020100 
01020200 
01020300 
01020400 
01020500 
01020600 
01020700 
01020800 
01020900 
01021000 



p8 = £rec8; 
p9 = Trec9; 
plO = TreclO 
pll = Trecll 
pl2 = Trecl 2 
pl3 = Trecl3 
pl4 = Trecl4 
pl5 = Trecl5 
var 

ptrl : pi; 
ptr2 : p2; 
ptr3 : p3; 
ptr4 : p4; 
ptr5 : p5; 
ptr6 : p6; 
ptr7 : p7; 
ptr8 : p8; 
ptr9 : p9; 
ptrlO : plO 
ptrll : pll 
ptr!2 : pl2 
ptrl3 : pl3 
ptr!4 : pl4 
ptr!5 : pl5 
begin 

new(ptrl); ptrlf.i:=0 
new(ptr2); ptr2t.i:=0 
new(ptr3); ptr3f.i:=0 
new(ptr4); ptr4t.i:=0 
new(ptr5); ptr5t.i:=0 
new(ptr6); ptr6T.i:=0 
new(ptr7); ptr7f.i:=0; 
new(ptr8); ptr8t.i:=0; 
new(ptr9); ptr9f.i:=0; 
new(ptrlO); ptrl0f.i:=0 ( 
new(ptrll); ptrllt.i:=0, 
new(ptrl2); ptrl2f.i:=0 ( 
new(ptrl3); ptrl3t.i:=0, 
new(ptrl4); ptrl4t.i:=0, 
new(ptrl5); ptrl5f.i:=0 
with ptrlt do 
with ptr2t do 
with ptr3f do 
with ptr4t do 
with ptr5t do 
with ptr6t do 
with ptr7t do 
with ptr8T do 
with ptr9T do 
with ptrlOt do 
with ptrll f do 
with ptrl2T do 
with ptrl3f do 
with ptrl4t do 
with ptrl5f do 
i:=5; 
writelnC >15 LEVELS OF WITH STATEMENTS ALLOWED. . .6.8. 3.10-7 ') ; 
end. 
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{TEST 6.9.1-1, CLASS=€ONFORMANCE} 01026900 

01027000 

{ This program checks that the functions eoln and eof are 01027100 

correctly implemented. The compiler fails if the program does 01027200 

not compile or the program prints FAIL. } 01027300 

01027400 

program t6p9pldl (f ,output) ; 01027500 

var 01027600 

f:text; 01027700 

counter: integer; 01027800 

c-.char; 01027900 

begin 01028000 

rewrite (f); 01028100 

counter :=0; 01028200 

writeln(f,l); 01028300 

writelnff/A*); 01028400 

reset (f); 01028500 

while not eoln(f) do 01028600 

read(f,c); 01028700 

read(f,c); 01028800 

if (c=' ') then 01028900 

counter :=counter+l; 01029000 

read(f,c); 01029100 

if (c^'A*) then 01029200 

counter :=counter+l; 01029300 

if eoln(f) then 01029400 

counter :=counter+l; 01029500 

read(f,c); 01029600 

if eof(f) then 01029700 

counter :=counter-KL; 01029800 

if (counter=4) then 01029900 

writelnC PASS. . .6.9.1-1, EOLN AND EOF') 01030000 

else 01030100 

writeln('FAIL...6.9.1-l, EOLN AND EOF ') ; 01030200 

end. 01030300 



{TEST 6.9.2-1, CLASS=CONFORMANCE} 

{ This test checks that a single read statement with many 
variables is equivalent to many read statements containing 
one variable each. The compiler fails if the program does not 
compile or the program prints FAIL. } 

program t6p9p2dl (f ,output) ; 
var 

frtext; 

a, b,c,d,e: integer; 

al,bl,cl,dl, el: integer; 
begin 

rewrite(f) ; 

wrltelnff,' 12 3 4 5'); 

reset(f); 

read(f ,a,b,c,d,e) ; 

reset (th- 
read (f,al) ; 

read(f,bl); 

read(f,cl); 

read(f,dl); 

read (f, el); 

if(a=al) and (b=bl) and (c=cl) and (d=dl) and (e=el) then 
writelnC PASS. ..6.9.2-1, READ*) 

else 

writelnC FAIL. . .6.9.2-1, READ*); 
end. 



{TEST 6.9.2-2, CLASS=CONF0RMANCE} 

{ This test checks that a read of a character variable is 
equivalent to correctly positioning the buffer variable. 
The compiler fails if the program does not compile or the program 
prints FAIL. } 

program t6p9p2d2 (f ,output) ; 
var 

f:text; 

a,b,al,bl:char; 
begin 

rewrite(f) ; 

writeln(f,'ABC , ) ; 

reset ( f ) ; 

read(f ,a) ; 

read(f ,b) ; 

reset ( f ) ; 

al:=ft; get(f); 

bl:=fT; get(f); 

if(a=al) and (b=bl) 
writelnC PASS.. 

else 

writelnC FAIL., 
end. 



then 
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{TEST 6.9.2-3, CLASS=CONFORMANCE} 

{ This test checks that integers and reals are read correctly 
from a file. The compiler fails if the program does not 
compile or the program prints FAIL. } 

program t6p9p2d3 (f ,output) ; 
var 

frtext; 

i,j : integer; 

r,s:real; 
begin 

{ Internal (compile-time conversions) and run-time conversions 
should result in the same value, hence justifying the 
equality tests on real numbers. } 

rewrite (f); 

writeln(f,' 123 123.456 5 123E6 '); 

reset (f); 

read(f,i,r,j,s); 

if(i=123)and(r=123.456) and (j=5) and (s=123E6) then 

writelnC PASS. . .6.9.2-3, READ') 
else 
begin 

if (i=123) and (j=5) then 

writelnC FAIL. . .6.9.2-3, READ REAL CONVERSIONS » ) 
else 

writelnC FAIL. . .6.9.2-3, READ') 
end; 
end. 



{TEST 6.9.2-4, CLASS=ERRORHANDLING} 

{ This test checks that an error is produced when an attempt 
is made to read an integer but the sequence of characters 
on the input file does not form a valid signed integer. } 

program t6p9p2d4 (f ,output) ; 
var 

frtext; 

i: integer; 
begin 

rewrite(f) ; 

writeln(f,'ABC123'); 

reset (f); 

read(f,i); {should cause an error} 

writelnC ERROR NOT DETECTED. . .6.9.2-4 ') ; 
end. 
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{TEST 6.9.2-5, CLASS=ERRORHANDLING } 

{ This test checks that an error is produced when an attempt 
is made to read a real but the sequence of characters 
on the input file does not form a valid real. } 

program t6p9p2d5 (f ,output) ; 
var 

frtext; 

r:real; 
begin 

rewrite(f) ; 

writeln(f,'ABC123.456'); 

reset ( f ) ; 

read(f,r); {should cause an error} 

writelnC ERROR NOT DETECTED. . .6.9.2-5*) ; 
end. 



{TEST 6.9.3-1, CLASS=C0NFORMANCE} 

{ This test checks that readln is correctly implemented. 
The compiler fails if the program does not compile or the 
program prints FAIL. } 

program t6p9p3dl (output) ; 
var 

f rtext; 

a,b,c:char; 

counter : integer ; 
begin 

counter :=0; 

rewrite (f) ; 

writeln(f,'ABC); 

writeln(f,'DE'); 

reset ( f ) ; 

readln(f ,a,b,c) ; 

read(f ,a) ; 

if (a= , D l ) then counter :=counter+l; 

reset ( f ) ; 

read(f ,a,b,c) ; 

readln(f) ; 

read(f ,a) ; 

if(a='D') then counter :=counter+l; 

reset (f) ; 

read(f ,a) ; 

while not eoln(f) do get(f); 

get(f); 

if (fT='D') then counter r=counter+l; 

if ( counters ) then 

writelnC PASS. . .6.9.3-1, READLN') 

else 

writelnC FAIL. . .6.9.3-1, READLN'); 
end. 
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{TEST 6.9.4-1, CEASS=CONFORMANCE} 01045800 

01045900 

{ This test checks that a write procedure with many parameters 01046000 

is equivalent to many write procedures with one parameter each. 01046100 

The compiler fails if the program does not compile or the program 01046200 

prints FAIL. } 01046300 

01046400 

program t6p9p4dl (f ,output) ; 01046500 

var 01046600 

f:text; 01046700 

a , b ,c r d , e :char ; 01046800 

al,bl,cl,dl,el:char; 01046900 

counter: integer; 01047000 

begin 01047100 

counter :=0; 01047200 

rewrite(f); 01047300 

a:='A»; 01047400 

b:='B'; 01047500 

c:='C % ; 01047600 

d:='D'; 01047700 

e:='E»; 01047800 

write(f,a,b,c,d,e); 01047900 

writeln(f); 01048000 

reset (f); 01048100 

read(f,al,bl,cl,dl,el); 01048200 

if (a=al) and (b=bl) and (c=cl) and (d=dl) and (e=el) then 01048300 

counter :=counter+l; 01048400 

rewrite(f); 01048500 

write (f,a); 01048600 

write(f,b); 01048700 

write (f,c); 01048800 

write(f,d); 01048900 

write(f,e); 01049000 

writeln(f); 01049100 

reset (f); 01049200 

read (f ,al ,bl ,cl ,dl ,el) ; 01049300 

if(al=a) and (bl=b) and (cl=c) and (dl=d) and (el=e) then 01049400 

counter :=counter+l; 01049500 

if (counter=2) then 01049600 

writelnC PASS. ..6.9.4-1, WRITE') 01049700 

else 01049800 

writelnC FAIL. . .6.9.4-1, WRITE'); 01049900 

end. 01050000 



{TEST 6.9.4-2, CLASS=CONFORMANCE} 

{ This test checks that the default value for the field width of a 
character type is one. The compiler fails if the program does not 
compile or the program prints FAIL. } 



program t6p9p4d2 (f ,output) ; 
var 

f:text; 

a,b:char; 
begin 

rewrite(f); 

a:='A»; 

b:='B'; 

writeln(f,a,b) ; 

reset ( f ) ; 

read(f ,a,b) ; 

if (a='A') and (b='B') then 

writelnC PASS. . .6.9.4-2, WRITE') 

else 

writeC FAIL. . .6.9.4-2, WRITE'); 
end. 
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{TEST 6.9.4-3, CLASS CONFORMANCE} 

{ This test checks the implementation of integer output. 
The compiler fails if the program does not compile or the program 
prints FAIL. } 

program t6p9p4d3 (f ,output) ; 
var 

f ttext; 

archar; 

bzpacked array [1..26] of char; 

i: integer; 
begin 

rewrite (f) • 

writelnC f,0: 3, 1:3,-1: 3, 10: 3,99: 3, 100: 3,-100: 3, 1111: 3) ; 

reset ( f ) ; 

for i:=l to 26 do 
read(f,b[i]); 

if (b=' 1 -1 10 99100-1001111') then 

writelnC PASS. ..6.9.4-3, WRITE INTEGERS') 

else 

writelnC FAIL. . .6.9.4-3, WRITE INTEGERS'); 
end. 
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{TEST 6.9.4-4, CLASS=CONF0RMANCE} 01054700 

01054800 

{ This program checks that real numbers are correctly written to 01054900 

text files. The compiler fails if the program does not compile 01055000 

or the program prints FAIL. } 01055100 

01055200 

program t6p9p4d4 (f ,output) ; 01055300 

var 01055400 

fttext; 01055500 

a:packed array [1..26] of char; 01055600 

b:packed array [1. .24] of char; 01055700 

i: integer; 01055800 

counter: integer; 01055900 

begin 01056000 

rewrite(f); 01056100 

counter :=0; 01056200 

writeln(f,0.0:6,1.0:5,1.0:10); 01056300 

reset (f); 01056400 

for i:=l to 26 do 01056500 

read(f,a[i]); 01056600 

if (a=' 0.0 1.0 1.000E+00') then 01056700 

counter :=counter+l; 01056800 

rewrite(f); 01056900 

writeln(f, 0.0:4: 1,1. 0:6: 1,-1. 0:6: 1,123. 456:7: 3); 01057000 

reset (f); 01057100 

for i:=l to 24 do 01057200 

read(f,b[i]); 01057300 

if (b=' 0.0 1.0 -1.0 123.456') then 01057400 

counter :=counter+l; 01057500 

if (counter=2) then 01057600 

writelnC PASS. . .6.9.4-4, WRITE REALS 1 ) 01057700 

else 01057800 

writelnC FAIL. . .6.9.4-4, WRITE REALS ») ; 01057900 

end. 01058000 



{TEST 6.9.4-5, CLASS=IMPLEMFNTATIONDEFINED} 

{ This program determines the implementation defines value which 
represents the number of digit characters written in an exponent. } 

program t6p9p4d5 (f ,output) ; 
var 

f:text; 

c:char; 

i: integer; 
begin 

rewrite(f) ; 

writeln(f, 1.0:10, 'ABC'); 

reset ( f ) ; 

repeat 

read(f ,c) ; 

until (c='E'); 

read(f ,c) ; 

i:=-l; 

repeat 

read(f ,c) ; 
i:=i+l; 

until (c='A'); 

writelnC THE NUMBER OF DIGITS WRITTEN IN AN EXPONENT IS',i:5); 
end. 
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{TEST 6.9.4-6, CLASS=CONFORMANCE} 01060600 

01060700 

{ This test checks that strings are correctly written onto a text 01060800 

file. The compiler fails if the program does not compile or 01060900 

the program prints FAIL. } 01061000 

01061100 

program t6p9p4d6 (f ,output) ; 01061200 

var 01061300 

frtext; 01061400 

i,j,k, counter: integer; 01061500 

c:char; 01061600 

begin 01061700 

rewrite(f); 01061800 

counter :=0; 01061900 

for i := 1 to 10 do 01062000 

writeln(f,'AAAAA':i,'B':l); 01062100 

writeln(f,'BBBBB','C':l); 01062200 

reset (f); 01062300 

for i:=l to 10 do 01062400 

begin 01062500 

for j:=6 to i do begin 01062600 

read(f,c); 01062700 

if (c=' ») then 01062800 

counter :=counter+l; 01062900 

end; 01063000 

if (i>5) then k:=5 else k:=i; 01063100 

for j:=l to k do 01063200 

begin 01063300 

read(f,c); 01063400 

if(c='A') then 01063500 

counter :=counter+l; 01063600 

end; 01063700 

read(f,c); 01063800 

if (c='B') then 01063900 

counter :=counter+l; 01064000 

readln(f); 01064100 

end; 01064200 

for i:=l to 5 do 01064300 

begin 01064400 

read(f,c); 01064500 

if (c=*B') then 01064600 

counter :=counter+l; 01064700 

end; 01064800 

read(f,c); 01064900 

if (c='C) then 01065000 

counter :=counter+l; 01065100 

if(counter=71) then 01065200 

writelnC PASS. . .6.9.4-6, WRITE STRINGS ' ) 01065300 

else 01065400 

writelnC FAIL. . .6.9.4-6, WRITE STRINGS ») ; 01065500 

end. 01065600 



{TEST 6.9.4-7, CLASS=CONFORMANCE} 

{ This test checks that boolean variables are correctly written 
to text files. The compiler fails if the program does not compile 
or the program prints FAIL. } 

program t6p9p4d7 (f, output) ; 
var 

f:text; 
b,c: boolean; 

a:packed array[1..10] of char; 
i: integer; 
begin 

{ This treatement is believed to be very dubious and may be 
altered in the future versions of the standard: 
A.H.J. Sale 1979 June 1 } 
rewrite(f) ; 
b:=true; 
c:=not b; 

writeln(f,b:5,c:5); 
reset ( f ) ; 
for i:=l to 10 do 

read(f ,a[i] ); 
if (a='TRUE FALSE') then 

writelnC PASS. ..6.9.4-7, WRITE BOOLEAN') 
else 

writelnC FAIL. . .6.9.4-7, WRITE BOOLEAN ') ; 
end. 



{TEST 6.9.4-8, CLASS =DE VI ANCE} 

{ This program attempts to output an integer number using a real 
format. The compiler deviates if the program prints DEVIATES. } 

program t6p9p4d8 (output) ; 
var 

i: integer; 
begin 

i:=123; 

writeln(i:6:l); 

writelnC DEVIATES. . .6.9.4-8, WRITE'); 
end. 
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{TEST 6.9.4-9, CLASS=DEVIANCE} 

{ This test attempts to output integers whose field width parameter 
are zero or negative. The compiles deviates if the program prints 
DEVIATES. } 

program t6p9p4d9 (output) ; 
var 

i: integer; 
begin 

for i:=10 downto -1 do 

writelnC *,'.*:i, *REP=',i); 

writelnC DEVIATES. . .6.9.4-9, WRITE*); 
end. 
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{TEST 6.9.4-10, CLASS=OUALITY} 

{ This program checks that data written appears on the output 
file regardless of the omission of a line marker. The common 
error is to buffer output and fail to flush the buffers at 
end of job. } 

program t6p9p4dl0 (output) ; 
begin 

write (• OUTPUT IS FLUSHED AT END_0F_J0B. . .6.9.4-10') 
end. 
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{TEST 6.9.4-11, CLASS=IMPLEMENTATIONDEFINED} 

{ This program determines the implementation defined default 
field width for writing integer, boolean and real types. } 

program t6p9p4dll (f ,output) ; 
var 

f:text; 

crchar; 

i,j : integer; 

function readfield: integer; 
var 

i: integer; 
begin 
i:=0; 
repeat 

read(f,c); 

i:=i+l; 
until (c='Z'); 
readfield :=i-l; 
end; 

begin 

rewrite (f) ; 

writeln(f,l,'Z',100,'Z'); 

writeln(f ,false,'Z' ,true,'Z'); 

writeln( f, 1.0,* Z', 1000.0,' Z 1 ); 

reset ( f ) ; 

writelnC IMPLEMENTATION DEFINED DEFAULT FIELD WIDTH VALUES'); 

i:=read field; 

j:=read field; 

if (i=j) then 

writelnC INTEGERS: ' ,i : 5, ' CHARACTERS') 
else 

writelnC THE VALUE VARIES ACCORDING TO THE SIZE OF THE INTEGER'); 
readln(f); 
i:=read field; 
j:=readfield; 
if (i=j) then 

writelnC BOOLEAN: ' ,i:5,' CHARACTERS') 
else 

writelnC THE VALUE VARIES ACCORDING TO THE BOOLEAN VALUE'); 
readln(f) ; 
i:=read field; 
j :=read field; 
if (i=j) then 

writelnC REAL:',i:5,' CHARACTERS') 
else 

writelnC THE VALUE VARIES ACCORDING TO THE SIZE OF THE REAL'); 
end. 
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{TEST 6,9.4-12, CLASS=DEVTANCE} 

{This program checks whether an unpacked array of characters 
can be output. The compiler deviates if the program prints 
DEVIATES. } 

I program t6p9p4dl2 (output) ; 

I var 

s:array[1..3] of char; 
begin 

s[l]:=»R'; s[2]: = 'A'; s[3]:='N'; 

writelnC RAN=' ,s) ; 

writelnC DEVIATES. ..6.9.4-12, WRITE 1 ); 
end. 



{TEST 6.9.4-13, CLASS=CONFORMANCE} 

{ This program attempts to perform recursive I/O using a 
different file for the second I/O action. } 

prog ram t6p9p4dl 3 ( f ,output) ; 
var 

frtext; 

function a( i: integer) : integer; 
begin 

writeln(f,i); 

a:=i; 
end; 

begin 

rewrite(f) ; 

writeln(a(l)); 

writelnC RECURSIVE I/O ALLOWED USING DIFFERENT FILES'); 

writelnC PASS. . .6.9.4-13, RECURSIVE I/O'); 
end . 



{TEST 6.9.4-14, CLASS=QUALITY} 

{ This program attempts to perform recursive I/O using the 
same file for the second I/O action. 

The semantics of write are not sufficiently well-defined to 
establish what should occur. It depends on evaluation orders, 
etc., which is why this test is in the quality section. } 

program t6p9p4dl4 (f ,output) ; 

function a ( i : integer) : integer; 
begin 

writeln( i); 

a:=i; 
end; 

begin 

writeln(a(l)); 

writelnC RECURSIVE I/O ALLOWED USING THE SAME FILE. . .6.9.4-14 ') ; 
end. 
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{TEST 6.9.4-15, CLASS=CONFORMANCE} 

{ This test checks that a write that does not specify the file 
always writes on the default file at the program level, not 
any local variable with the same name. } 

program t6p9p4dl5 (output) ; 
procedure p; 
var 

output r text; 
begin 

rewrite (output) ; 

writeln(output,' FAIL. . .6.9.4-15*) ; 

writelnC PASS. . .6.9.4-15') 
end; 
begin 

P 
end. 



{TEST 6.9.5-1, CLASS=C0NFORMANCE} 

{ This program checks the implementation of procedure writeln. 
The compiler fails if the program prints FAIL or the program 
does not compile. } 

program t6p9p5dl (f ,output) ; 
var 

frtext; 

a,b:packed array[1..10] of char; 

i:integer; 
begin 

rewrite(f); 

writeln(f,l:5,'ABCDE'); 

write(f,l:5,'ABCDE'); 

writeln (f) ; 

reset ( f ) ; 

for i:=l to 10 do 
read(f ,a[i] ); 

reset ( f ) ; 

for i:=l to 10 do 
read(f,b[i]) ; 

if (a=b) then 

writelnC PASS. . .6.9.5-1, WRITELN') 

else 

writelnC FAIL. . .6.9.5-1, WRITELN'); 
end. 
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{TEST 6.9.6-1, CIASS=CONFORMANCE} 

{ This program checks that the procedure page is implemented. 
This conformance test is unable to determine whether the compiler 
passes or fails - the user must check that a page has been 
generated. } 

program t6p9p6dl (output) ; 
begin 

writelnC PAGE GENERATION TEST'); 

page (output) ; 

writelnC IF THIS LINE IS PRINTED ON THE TOP OF A NEW PAGE'); 

writelnC THEN PASS. . .6.9.6-1, PAGE'); 

writelnC ELSE FAIL. . .6.9.6-1, PAGE*); 
end. 



{TEST 6.10-1, CLASS=OEVIANCE} 

{ This test checks the effect of using a default file not declared in 
the program heading. Ttie compiler deviates if the program 
prints DEVIATES. } 

program t6pl0dl ( input) ; 
begin 

writelnC DEVIATES. . .6.10-1, FILE DECLARATION'); 
end. 
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{TEST 6.10-4, CLASS=DEVTANCE} 

{ This program has no program statement. Some compilers may 
assume the existence of such a statement if none is present. 
The compiler deviates if the program compiles and prints 
DEVIATES. } 



var 

i:integer; 
begin 

i:=5; 

writelnC DEVIATES, 
end. 



.6.10-4, PROGRAM , ) 



{TEST 6.11-1, CLASS=IMPLEMENTATIONDEFINED} 

{ This program checks whether equivalent symbols can be used for 
the standard reference representation. The equivalent symbols 
for comment delimiters are tested. They are implemented if 
the program prints ALTERNATE COMMENT DELIMITERS IMPLEMENTED. } 

program t6plldl (output) ; 

(* Test of alternate comment delimiters *) 

begin 
(* test of alternate comment delimiters. If these delimiters 
are not implemented the compiler will give a syntax error. *) 
writelnC ALTERNATE COMMENT DELIMITERS IMPLEMENTED. . .6.11-1 ') ; 

end. 
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{TEST 6.10-2, CLASS=IMPLEMENTATIONDEFINED} 

{ This program checks the effect of doing a rewrite on the 
standard file output. The effect is implementation dependent. } 

program t6pl0d2 (output) ; 
begin 

rewrite (output) ; 

writelnC IMPLEMENTATION DEPENDENT. . .6. 10-2') ; 

writelnC A REWRITE HAS BEEN PERFORMED ON FILE OUTPUT'); 
end. 
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{TEST 6.10-3, CLASSOEVTANCE} 

{ This program checks that the default file output is 

implicitly declared at the program level by attempting to 
redefine it. The file input should be identical, of course. 
The test should not compile. } 

program t6pl0d3 (output) ; 
var 

output: integer; 
begin 

output :=1; 

writelnC DEVIATES. . .6.10-3, OUTPUT REDEFINED') 
end. 
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{TEST 6.11-2, CLASS=IMPLEMEMTATIONDEFINED} 

{ This program checks whether equivalent symbols can be used for 
the standard reference representation. The equivalent symbols 
for the up-arrow, :, ;, :=, and [ ] are tested. The equivalent 
symbols are implemented if the program prints 
EQUIVALENT SYMBOLS ARE IMPLEMENTED. } 

program t6plld2 (output) ; 
type 

rec = record 

a, b: integer 
end; 
ptrl=@rec; 
ptr2=frec; 

{ The above two statements use the equivalent symbols for the 
up-arrow } 

var 

arrrarray (. 1..10 .) of integer; 

i % integer; 

r : real ; 

s : real ; 

j,k,l : integer; 
begin 

J .» 5; 

k %= 6; 

s:=1.0; 

1 := 7 ., 

s:=1.0; 

writelnC EQUIVALENT SYMBOLS ARE IMPLEMENTED. . .6.11-2') ; 
end. 



{TEST 6.11-3, CLASS=IMPLEMENTATIONDEFINED} 

{ This program checks whether equivalent symbols can be used for 
the standard reference representation. The equivalent symbols 
for the arithmetic operators <,>,<=,>=,<> are checked. They 
are implemented if the program prints EQUIVALENT SYMBOLS ARE 
IMPLEMENTED. } 

program t6plld3 (output); 
var 

j,k,l : integer; 

b : boolean; 
begin 

k:=2; 

b := j GT k; 
b := j LT k; 
:= j GE k; 
j 



LE k; 



b 
b 

b := j NE k; 
writeln(* EQUIVALENT SYMBOLS ARE IMPLEMENTED, 
end. 



.6.11-3') ; 
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THREE SAMPLE VALIDATION REPORTS 

{ A fourth report came to hand very late in the preparation of this issue, and it is 
also included. } 

Introduction 



In this section we present three samples of Validation Reports on processors. 
Care is needed in the interpretation of these Reports for several reasons. 
Firstly, they are a snapshot in time of the processor concerned; some of the 
reported flaws will be fixed by the maintainers, perhaps even before this is 
printed. Secondly, some processors contain intended extensions, or have an 
interpretation which anticipates a change in the draft Standard in its route 
to finalization. Nevertheless, it is felt that publication of these Reports 
will 

(a) encourage other users to test processors accessible to them 
and publish the results in Pascal News, 

(b) indicate likely portability problem areas, and 

(c) illustrate the type of report which will be meaningful 
to users of Pascal. 

It must be emphasized that these reports are simply of processors which were 
reasonably convenient for us to test. The report on the Burroughs B6700 
compiler originating at the 1 University of California is a user's viewpoint 
of an unmodified system. There is no good reason to suspect that the report 
is particularly bad (or particularly good). It is likely to be representa- 
tive of the results other users will achieve with their processors. 

The report on the Burroughs B6700/7700 compiler originating at the University 
of Tasmania is somewhat different. Firstly, it is our own processor, and 
the report is therefore prepared with greater knowledge of what is happening 
(not simply noting a bald failure for unknown reasons as we have had to 
record in other situations). Secondly, and more importantly, it has been 
the prime testbed for the validation suite which has resulted in most of 
the minor faults being fixed as soon as they <are detected. Consequently, 
only a few of the more difficult areas remain to be reported by the 
Validation Suite. 

The report of the P4 compiler gives an indication of how the portable Pascal 
systems conform to the standard. 

The test runs which led to these reports were carried out by: 

R.A. Freak 
CD. Keen 

Annotation and analysis were carried out by: 

R.A. Freak 
A.H.J. Sale 
CD. Keen 

(For the benefit of Pascal users who want to carry out similar Validation 
Tests on their processors, we estimate the time required to do this as about 
1-5 man days, depending on familiarity with the processor, turn-around time, 
etc. Fixing the flaws, of course, takes a lot longer). 
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PASCAL VALIDATION SUITE REPORT 



Pascal Processor Identification 



Computer: 
Processor: 



Burroughs B6700 

B6700 Pascal version 2.9.178.008 

(University of California at San Diego compiler) 



Test Conditions 

Tester: R.A. Freak (a user at the University of Tasmania) 

Date: August 1979 

Validation Suite Version: 2.2 

Conformance Tests 



Number of tests passed: 118 

Number of tests failed: 21 (13 basic causes) 



Details of failed tests : 

Test 6.1.5-2 failed because long numbers are not accepted 
by the compiler. 

Tests 6.4.3.2-3, 6.6.3.1-2 and 6.8.2.1-1 failed because 
booleans are not permitted to be used as array indexes. 

Tests 6.4 .3.3-1 and 6.4.3.3-3 fail because empty records 
or empty fields are not permitted by the compiler. 

Test 6.4.3.5-1 shows that a file of pointer is not allow- 
ed. 

Tests 6.4.3.5-2, 6.6.5.2-3, 6.6.5.2-4, 6.6.5.2-5, 6.9.1-1 
all fail because the implementation of textfiles is non 
standard - particularly the handling of eof and eoln. 

Test 6.4.3.5-4 indicates that the file output is not 
flushed at the end of a program. 

Test 6.5.1-1 shows that a file of char is not permitted 
in a record. 

Test 6.6.3.1-5 failed because of an inconsistency in the 
implementation of procedure parameters. 

Test 6.6.5.4-1 failed because the procedures pack and 
unpack have not been implemented according to the 
standard. 



Test 6.8.3.5-4 fails because the maximum range of case 
labels is 1000. 

Tests 6.9.4-4 and 6.9.4-7 fail because I/O involving 
reals and booleans is not standard. 



:> 

GO 
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Test 6.9.4-13 fails because a file variable is expected 
in a write statement. 

Test 6.9.4-15 fails because a local file output is used 
for the default file. 



GO 



Deviance Tests 

Number of deviations correctly detected: 62 

Number of tests showing true extensions: 5 

Number of tests not detecting erroneous deviations: 28 (11 basic causes) 

Details of extensions : 

Test 6.1.5-6 shows that a lower case e may be used in 
real numbers (e.g. 1.602e-20). 

Test 6.1.7-6 shows that strings can have bounds other 
than 1. .n. 

Test 6.1.7-11 shows that a null string is accepted by 
the compiler. 

Tests 6.8.3.9-9 and 6.8.3.9-14 indicate that a non- 
local variable or a global variable may be used for a 
for statement control variable. 



Details of deviations not detected : 

Test 6.1.2-1 shows that the reserved word nil may be 
redefined. 

Tests 6.2.2^4, 6.2.2-9, 6.3-5, 6.3-6, 6.4.1-3 contain 
a scope error which is not detected by the compiler. 

Tests 6.4.5-2, 6.4.5-3, 6.4.5-4, 6.4.5-5 and 6.4.5-13 
indicate that type compatibility is used with var 
parameters rather than enforcing identical types. 

Test 6.6.1-6 shows that a forward procedure declaration 
without a procedure body is not detected. 

Test. 6.6.. -5 shows that a function without an assign- 
ment to the function value variable in its block compiles 
and runs. 
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'lests 6.6.3.5-2, 6.6.3.6-2 and 6.6.3.6-4 show that 
function parameters are assignment compatible. 
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Test 6.6.6.5-3 shows that the function odd may be 
used with a real parameter. 

Test 6.7.2.2-9 shows that a unary plus sign may be 
used with character operands. 

Tests 6.8.2.4-2, 6.8.2.4-3 and 6.8.2.4-4 show that a 
goto between branches of a statement is permitted. 

Tests 6.8.3.8-2, 6.8.3.8-3, 6.8.3.8-4, 6.8.3.8-5, 
6.8.3.8-16 and 6.8.3.8-19 show that a for statement 
control variable may be altered during the execution 
of the for loop. 

Test 6.9.4-9 indicates that a negative field width 
may be used in a write statement. 



Error handling 

Number of errors correctly detected: 

Number of errors not detected: 



18 



27 (12 basic causes) 



Details of errors not detected 

Tests 6.4.3.3-5, 6.4.3.3-6, 6.4.3.3-7 and 6.4.3.3-8 
indicate that no checking is performed on the tag field 
of variant records. 

Test 6.4.3.3-12 shows that an assignment to an empty 
record is not detected. 

Test 6.4.6-4 indicates that no bounds checking is 
performed on subranges. 

Tests 6.4.6-7 and 6.4.6-8 indicate that no bounds 
checking is performed on set operations. 

Test 6.6.2-6 shows that the use of a function without 

an assignment to the function-value-variable is permitted. 

Tests 6.6.5.2-1, 6.6.5.2-2, 6.6.5.2-6 and 6.6.5.2-7 fail 
because I/O has not been implemented strictly according 
to the standard - particularly the handling of eof and 
eotn. 

Tests 6.6.5.3-3, 6.6.5.3-5 and 6.6.5.3-6 fail because 
no check is performed on the pointer parameter of 
dispose. 

Tests 6.6.5.3-7, 6.6.5.3-8 and 6.6.5.3-9 fail because 
no checks are inserted to check pointers after they have 
been assigned a value using the variant form of new. 

Tests 6.6.6.4-4, 6.6.6.4-5 and 6.6.6.4-7 fail because no 
bounds checks are inserted for the succ, pred or nhv 
functions. 



Tests 6.7.2.2-6 and 6.7.2.2-7 fail because integer over- 
flow/underflow is not detected. 



Test 6.7.2.4-1 fails because operations on overlapping 
sets are not detected. 

Tests 6.8.3.9-6 and 6.8.3.9-17 fail because a for 
control variable is not invalid after the execution of 
the for loop. 



Implementat iondef ined 

Number of tests run: 15 

Number of tests incorrectly handled: 1 



GO 
O 



CO 

I— » 



Details of implementation-dependence 

Test 6.4.2.2-7 shows maxint to be 549755813887. 



Tests 6.4.3.4-2 and 6.4.3.4-4 show that all set bounds 
must be positive. A set of char is permitted. 

Test 6.6.6.1-1 shows that no standard functions may be 
used as parameters. 

Test 6.6.6.2-11 details some machine characteristics 
regarding number formats. 

Tests 6.7.2.3-2 and 6.7.2.3-3 show that boolean expres- 
sions are fully evaluated. 

Tests 6.8.2.2-1 and 6.8.2.2-2 show that a variable is 
selected before the expression is evaluated in an assign- 
ment statement. 

Test 6.9.4-11 details the default field width specifica- 
tions: 10 for integers and booleans. The output format 
for reals fails in test 6.9.4-5. 
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Test 6.10-2 indicates that a rewrite on the standard file 
output is permissible. 

Tests 6.11-1, 6.11-2 and 6.11-3 show that the alternative 
comment delimiters have been implemented, as have the 
alternative pointer symbols. No other equivalent symbols 
have been implemented. 



Quality Measurement 

Number of tests run: 23 

Number of tests incorrectly handled: 



Results of tests: 



Test 5.2.2-1 shows that identifiers are not distinguished p> 



over their whole length; only the first 12 characters 
are used. 
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Test 6.1.3-3 shows the number of significant characters 
in an identifier to be 12. 

Test 6.1.8-4 shows that no warning is given if a valid 
statement or a semicolon is detected in a comment. 

Tests 6.2.1-8, 6.2.1-9 and 6.5.1-2 indicate that large 
lists of declarations may be made in each block. 

An array with an integer indextype is not permitted 
(test 6.4.3.2-4). 



Extensions 



Number of tests run: 1 



Details of test : 

Test 6.8.3.5-14 shows that the otherwise clause in a 
case statement has not been implemented. However, a 
construct using an ELSE: label has been implemented. 
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Test 6.4.3.3-9 shows that variant fields of a record 
occupy the same space, using the declared order. 

Test 6.4.3.4-5 (Warshall's algorithm) took 10.497744 
seconds CPU time and 169 bytes on the Burroughs B6700. 

Test 6.6.1-7 shows that procedures cannot be nested 
to a level greater than 8. 

Tests 6.6.6.2-6, 6.6.6.2-7, 6.6.6.2-8, 6.6.6.2-9 and 
6.6.6.2-10 tested the sqrt, atan, exp, sin/cos and In 
functions and £11 tests were completed successfully, 
without any significant errors in the values. 



Test 6.7.2.2-4 shows that div and mod have been 
implemented consistently, mod returns the remainder 
of div . 

Test 6.8.3.5-2 shows that case constants do not have 
to be of the same type as the case-index, if the case- 
index is a subrange, but the constants must be compat- 
ible with the case-index. 

Test 6.8.3.5-8 shows that a large case statement (>256 
selections) is permissible. 
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Test 6.8.3.9-18 indicates that range checking is always 
used in a case statement after a for statement to check 
the for variable. 

Tests 6.8.3.9-20 and 6.8.3.10-7 indicate that for and 
with statements may be nested to a depth greater than 
15. 

Test 6.9.4-10 shows that file buffers are flushed at 
the end of the program. 

Test 6.9.4-14 indicates that recursive 1/0 is permitted, 
using the same file. 
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B6700-Tas 

PASCAL VALIDATION SUITE REPORT 



Pascal Process or Identification 
Computer: Burroughs B6700 
Processor: 



B6700 Pascal version 2.9.001 
(University of Tasmania compiler) 



Test Conditions 



Tester: R.A. Freak (implementation/maintenance team member) 
Date: August 1979 

Validation Suite Version: 2.2 

Conformance Tests 

Number of tests passed: 117 

Number of tests failed: 22 

Details of failed tests : 

Most of the failed tests fall into two categories - the 
B6700 Pascal I/O is non-standard and the passing of proce- 
dure/function parameters has not been implemented. 

Tests 6.4.3.1-3, 6.4.3.5-1, 6.4.3.5-2, 6.4.3.5-3, 6.5.1-1, 
6.5.3.4-1, 6.6.5.2-3, 6.6.5.2-4, 6.6.5.2-5, 6.9.1-1, 6.9.2-2, 
6.9.3-1, 6.9.4-3, 6.9.4-4, 6.9.4-7, 6.9.4-15, all fail 
because text has not been predefined, or the eof action or 
output format is not strictly standard-conforming. 

Tests 6.6.3.1-3, 6.6.3.1-5, 6.6.3.4-1, 6.6.3.4-2 and 
6.6.3.5-1 fail because the passing of procedure/function 
parameters has not yet been implemented. 

Test 6.4.3.3-1 fails because an empty record containing a 
semi -colon produces a syntax error. 



Deviance Test 

Number of deviations correctly detected: 

Number of tests showing true extensions: 

Number of tests not detecting erroneous deviations: 

Number of tests failed: 



71 
5 

13 (5 basic causes) 
6 (2 basic causes) 



Detai l_s_ of extensions : 

Test 6.1.5-6 shows that the lower case e may be used in 
real numbers (for example 1.6O2e-20). 

Test 6.6.2-5 shows that a function without an assignment 
to the function variable in its block compiles - the 
error is detected at run time as an uninitialized value. 

Test 6.9.3-8 shows that integers may be written using 
real formats. 

Test 6.10-1 shows that the file parameters in the program 
heading are ignored in B6700 Pascal . 

Test 6.10-3 shows that the file output may be redefined 
at the program level. 

Details of deviations not detected: 
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Test 6.1.2-1 shows that nil may be redefined. 

Tests 6.2.2-4, 6.3-6 and 6.4.1-3 show that a common scope 
error was not detected by the compiler. 

Tests 6.4.5-2, 6.4.5-3, 6.4.5-4, 6.4.5-5 and 6.4.5-13 
indicate that type compatibility is used with var parameter 
elements rather than enforcing identical types. 

Tests 6.8.2.4-2, 6.8.2.4-3 and 6.8.2.4-4 show that a goto 
between branches of a statement is permitted. 

Test 6.9.4-9 shows that integers may be written even though 
the field width is too small, but the format used is non- 
standard. 
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Det ails of failed tests : 

Tests 6.6.3.5-2, 6.6.3.6-2, 6.6.3.6-3, 6.6.3.6-4 and 6.6.3.6 
fail because procedure/function parameters have not been 
implemented. 

Test 6.9.4-15 fails because text has not been defined. 



-5^> 



Error Ha n dling 

Number of errors correctly detected: 22 

Number of errors not detected: 23 (6 basic causes) 

Details of errors not detected : The errors not detected 
fall into a number of categories: 

Tests 6.4.3.3-5, 6.4.3.3-6, 6.4.3.3-7 and 6.4.3.3-8 
indicate that no checking is performed on the tag field 
of variant records. 



An assignment to an empty record is not detected in test 
6.4.3.3-12. 
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Tests 6.4.6-4, 6.4.6-5, 6.4.6-7, 6.4.6-8, 6.5.3.2-1 
6.6.6.4-7 and 6.7.2.4-1 indicate that no bounds checking 
is performed on array subscripts, subranges, set operations 
or the CHR function. 

Tests 6.6.5.2-1, 6.6.5.2-2, 6.6.5.2-6 and 6.6.5.2-7 fail 
because I/O has not been implemented strictly according 
to the standard. 

Tests 6.6.5.3-3, 6.6.5.3-4, 6.6.5.3-5 and 6.6.5.3-6 fail 
because dispose always returns a nil pointer in B6700 
Pascal and no check is performed on the pointer parameter. 

Tests 6.6.5.3-7, 6.6.5.3-8 and 6.6.5.3-9 fail because no 
checks are inserted to check pointers after they have been 
assigned a value using the variant form of new. 



Implement at iondefined 

Number of tests run: 15 

Number of tests incorrectly handled: 1 

Details of implementation-dependence : 

Test 6.4.2.2-7 shows maxint to be 549755813887. 

Tests 6.4.3.4-2 and 6.4.3.4-4 show that the set bounds 
are and 47. A set of char is not permitted. 

Test 6.6.6.2-11 details some machine characteristics 
regarding number formats. 

Tests 6.7.2.3-2 and 6.7.2.3-3 show that boolean expres- 
sions are fully evaluated. 

Tests 6.8.2.2-1 and 6.8.2.2-2 show that a variable is 
selected before the expression is evaluated in an assign- 
ment statement. 

Tests 6.9.4-5 and 6.9.4-11 show that the default size for 
an exponent field on output is 2; for a real number it is 
15 and the size varies for integers and booleans according 
to the value being written. 

Test 6.10-2 indicates that a rewrite on the standard file 
output is permissible. 

Tests 6.11-1, 6.11-2 and 6.11-3 show that the alternative 
comment delimiters have been implemented, as have the 
alternative pointer symbols. No other equivalent symbols 
have been implemented. 

Test 6.6.6.1-1 fails because function parameters have not 
been implemented, and therefore standard functions cannot 
be used as procedure/function parameters. 



Quality Measurement 

Number of tests run = 23 

Number of tests incorrectly handled = 
Results of tests : 



Test 5.2.2-1 shows that identifiers are distinguished 
over their whole length. 

Test 6.1.3-3 shows that more than 20 significant 
characters may appear in an identifier, in fact, the 
number of characters in a line is allowed. 
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A warning is produced if a semicolon is detected in a 
comment (test 6.1.8-4). 

Tests 6.2.1-8, 6.2.1-9 and 6.5.1-2 indicate that large 
lists of declarations may be made in each block. 

Tests 6.6.1-7, 6.8.3.9-20 and 6.8.3.10-7 show that 
procedures, for statements and with statements may each 
be nested to a depth greater than 15. 

An array with an integer indextype is not permitted 
(test 6.4.3.2-4). 



Test 6.4.3.3-9 shows that variant fields of a record 
occupy the same space, using the declared order. 

Test 6.4.3.4-5 (Warshall's algorithm) took 0.816461 
sees CW and 143 bytes on the Burroughs B6700. 
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Tests 6.6.6.2-6, 6.6.6.2-7, 6.6.6.2-8, 6.6.6.2-9, 
and 6.6.6.2-10, tested the sqrt, atan, exp, sin/ cos and 
In functions and all tests were completed successfully, 
without any significant errors in the values. 

Test 6.7.2.2-4 shows that div has been implemented 
consistently for negative operands, returning trunc. 
mod returns the remainder of div . 

Tests 6.8.3.5-2 shows that case constants do not have to 
be of the same type as the case-index, if the case-index 
is a subrange, but the constants must be compatible with 
the case-index. 

Test 6.8.3.5-8 shows that a large case statement (>256 
selections) is permissible. 

Test 6.8.3.9-18 indicates that range checking is always 
used in a case statement after a for statement to check 
the for variable. 

Test 6.9.4-10 shows that file buffers are flushed at the 
end of a block but test 6,9.3-14 indicates that recursive 
I/O using the same file may produce unexpected results. 












Extensions 



Number of tests run 



1 



Test 6.8.3.5-14 shows that the otherwise clause in a 
case statement has been implemented according to the 
accepted convention. 



B6700 Pascal - Future Plans and Commentary on Results 

The Validation Suite has shown up a number of flaws in the Tasmania 
B6700 compiler, as documented in the preceding report. We expect that 
other compilers will typically fare worse in the number of different 
flaws detected because we have had the benefit of experience (and 
fixing bugs) as we were developing the suite. This brief document out- 
lines what we expect to do about them. 

(1) Minor Flaws 

Some of the reported flaws are easy to fix, and have survived to be 
reported to you only by an oversight, or because the relevant test has 
only recently been added to the suite. Examples are semicolons in empty 
records, and incorrect var parameter typing. These will be fixed as 
soon as possible, and probably before this document is released. 

(2) Substantial flaws 

Two major flaws have survived because they require a reasonable amount 
of work to repair. These are the deviations of the i/o system, which 
seem to indicate a revision of the i/o run-time system, and procedure 
and function parameters which could not have been implemented until 
the draft standard solution was published due to the insecurities in 
the original version. These are under revision, and will be fixed 
shortly. Procedure and function parameters particularly should not 
take long. 

(3) Long-term and medium-term improvements 

In the long term, we plan to implement techniques which we have evolved 
or borrowed for improving the security of Pascal in our compiler, such as 
checking bounds efficiently outside the B6700 hardware checks, providing 
correct scoping checks, checking the validity of goto-statements, etc. 
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PDP-11 OMSI 1 



VALIDATION REPORT 



MACHINE: 
COMPILER: 
DATE: 
TESTS' BY: 



DEC PDP-11 running RSTS V06C-03 
OMSI Pascal-1 (Field Test Version X1.2) 
1979 September 9 & 10 
Barry Smith, Oregon Software 
(Implementation/maintenance team) 
ANNOTATED BY: A.H.J. Sale ( 1979 September 13) 

© Copyright A. H.J. Sale 1979 
Not to be distributed nor reproduced without permission. 

CONFORMANCE TESTS 

Number of tests attempted: 137 

Number of tests passed: 122 

Number of tests failed: 15 ( 13 causes) 

Invalid tests discovered: 2 

6 > 1-8-3 Comment delimiters are not required to be pairwise matching; this 
makes \This part of the scanner looks for a *) delimiter} a disallowed 
comment. 

&- 2 * s ~ 3 Pointer scope is not handled correctly, so that correct programs 
fail to compile. 

$• 2 ' 2 ~ 8 A 3signment to function-identifier from within nested procedure or 

function generates bad code. 

6.4.3.3-1 Empty record types with semicolons and empty case variants are 

not permitted. 

6.4.3.5-2 and -3 An unknown interaction between RSTS I/O on temporary files 

and the implementation of the run- time support. 

S- 4 - 5 - 9 Z^l compatible sets of different basetypes do not compare equal. 

(Pascal-l scales the basetype to force a representation of bit on the 

lowerbound, giving errors in comparisons as shifts are not inserted to 

compensate. Also set of char is implemented as set of '<y..'«-' (64 chars)/) 

6.6.3.1-5 and 6.6.3.4-2 Only J&W procedural parameters allowed, not 

the N462 versions. The second test is relevant to the feature actually 

implemented, but has not been run with modifications. 

6.6.5.2-3 Does not check eof on an empty temporary file. 
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6.6.5. 4-1 Pack and unpack not implemented. 

6.8.2.2-1 Empty field specifications not allowed in record declarations. 

6.9-1 Eoln and eof not correct: relation between RSTS and implementation 

causes unknown fault. 

6.9.2-3 Conversions on reading real numbers are not identical to the 

conversions performed by the compiler. 

6.9.4-7 Writing boolean values is incorrectly rights justified. (ARTS 

comments that the new draft may change this or tighten up wording.) 

DEVIANCE TESTS 

Number of tests attempted: 95 

Number of extensions: 2 (as stated by B. Smith) 

Number of deviations: 41 (25 causes) 

6.1.5-4 Allows real number constants without digits after point. 

6.1.7-5 and 6.9.4—12 Packed is ignored so that packed array of char is 

identical to array of char, and similarly with other structures. 

6.1.7-6 and —7 The requirements to be a string-type are not checked, allowing 

deviant programs to execute. 

6.1.7-8 The requirements to be a string-type are not checked, together with 

an obvious error, allows erroneous values to be given to a type. 

6.1.7-11 Allows em,pty string: ie " is equivalent to packed array [l..oJ 

of char. 

6.2.2-4 Incorect scope allows incorrect program to compile. 

6.2. 2—7 Invalid program executes with (a) function whose identifier is 

inaccessible and (b) another function has an attempted assignment outside 

its block. 

6.2.2-9 A function-identifier may be assigned to outside its block. 

6.3-2. -3, -4, -5, 6.7.2.2—9 Signed characters, strings and enumerated types 

are allowed. 

6. 4.3.1-1 Allows packed scalar3, subranges, ie not restricted to structures. 

6. 4.3.1-2 Allows "packed" type-identifier. 

6. 4.3.2—5 String types are allowed to have non— integer subrange indextypes. 

6. 4.3.4-3 Set of real erroneously not detected. 

6. 4.5-2 Var parameters which are compatible but not identical are allowed. 

6.4.5-3 and -13 Non-identical array types allowed as var parameters. 

6.4.5-5 Non-identical pointer types allowed as var parameters. 



6.4.6-10. -11 and -12 Compiles file assignment a3 descriptor copy, and 
simi larly for records containing file components. 

6.6.2-5 Allows function definitions without any assignment to function- 
identifier. 

6.8.2.4-2. -3 and -4 Allows goto statements to transfer into structured 
statement components. 

6. 8. -1-9-2; -3, -4 and -16 Any assignment to a for-control-variable is 
allowed inside the controlled statement, and it in fact changes the value. 
6.8.3.9-9, —13 and. —14 Allows a for-control-variable to be program— global , 
non-local, or a var parameter. 

6.8.3.9-19 Two loops using same variable interact to produce infinite 
loop construction, and other insecurities. 

6.10-1 Ignore program parameters, allowing use of external file not stated.. 
6. 10—3 The files input and output are not implicitly declared at the 
program level, but at a lexically enclosing level. 

6.10-4 The entire program heading, including the reserved word progra.m, 
may be omitted. 

Claimed Extensions : 

6.7 . 2.3-4 And, gr_ and not are overloaded to be a representation-dependent 

set of operators on integer type. 

6. 9. 4—9 Negative field widths in writes of integers produces octal 

interpretation in field of abs(width) . 

ERRORHANDLING TESTS 

Number of tests attempted: 48 

Number of errors detected: 11 (9 causes) 

Number of tests failed: 2 

Tests failed : 

6.4.3.3-12 Crash at run-time due to empty record-field. 

6.6.5.2-2 Relation between RSTS I/O and implementation run-time support. 

Errors detected : 

6.4.6-6, 6.5.3.2-1 Assignment compatibility: indextype vs subscript value. 

6.6.5.2-1 Put not allowed if eof false. 

6.6.6.2-4 In(O.O) or ln(negative) 

6.6.6.2-5 sqrt( negative) , but continues execution 1 1 

6.6.6.2-2 trunc( larger eal) 

6.6.6.2-3 round( larger eal) 
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6.7.2.2-3, -8 Div and. mod by 0, but continues execution! i 

6.9.2-4 Read of text/He, but chars do not represent integer value, 

6.9.2-5 Read of textfile, but chars do not represent real value. 



QUALITY TESTS 

Number of tests attempted: 24 

Number of tests failed: 3 
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Errors not detected : 

Use of undefined values. 

Variant undefinition. 

All assignment compatibility except indextype in arrays. 

Nil or undefined pointer dereferencing. 

Undefined function result. 

File buffer aliasing and use of file. 

Dispose of nil or undefined pointer value. 

Dispose of variable currently var parameter or with aliased. 

Dynamic variant record used, in expression or assignment. 

Succ or jp"red of limiting value in type. 

Chr of very large integer. 

Overflow of integer type. 

Assignment compatibility with overlapping sets. 

Case expression with no matching label ( falls through). 

Use of for— control— variable after loop termination. 

Nested loops using same control-variable. 

IMPLEMENT A TI ON-DEFINED TESTS 

Maxint = 32767 . 

Set of char not implemented, but taken as equivalent to set of ',__,' ..'« 

Set limits are 0..63. 

Standard functions not allowed as functional parameters. 

Real representation has 24— bit mantissa, rounds on arithmetic, 

eps^5.96e-8; xmin=2.93e-39; xmax=1.70e+38. 
Full evaluation of boolean expressions. 
Selection then evaluation in <x£ij := exp. 
Evaluation then dereferencing in p-f := exp. 
Writes two exponent digits in real numbers. 
Default field widths integer 7 

boolean 5 

real 13 

Rewrite permitted on output. 
Both comment delimiters allowed, no others 



Tests failed : 

6. 2. 1-9 Compiler loops when presented- with program, with 50 labels. 

6.6.6.2-9 Compiler refuses to compile a real expression in sin/cos test 

due to "lack of registers" . 

6. 8. 3. 9—20 Compiler crashes after compiling 11 nested, for— loops. 

Qual i ty measurements : 

5.2.2-1, 6.1. 3-3 Any length identifiers allowed; disallows all mis-spellings 

6. 1.8-4 Unclosed comments swallow text without trace. 

6.2.1—8 Allowable number of types ^ 50. 

6.4.3.2-4 Array [integer] diagnosed but message not good. 

6. 4.3.3-9 Record fields allocated representation space in declaration order. 

6. 4.3. 4—5 Marshall' s algorithm timing/ space test not yet run. 

6.5.1—2 Allowable number of variable declarations ~%, 100. 

6.6.1-7 Allowable number of nested procedures must be <T 10. 

6.6.6.2-6* -7 t -8 and -9 Quality tests on sQrt, arctan, exp and In carried 

out. Some minor inconsistencies. 

6.7.2.2-4 Mod inconsistently implemented for negative operands. 

6.8.3.5—2 No warnings for impossible case clauses. 

6.8.3.5— 8_ Allowable number of case— constants ^ 256. 

6.5.3.9-18 Undefined (out-of -range) values of case expressions are possible 

and are undetected but do no violent damage. 

6.8.3.1.0—7 Allowable number of nested with- statements must be ^ 3. 

6.9.4-10 Textfile without eol at end is still printed. 

6.9.4—11 Recursive I/O allowed on same file, and still works. 
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Ran 16 implementation— defined tests successfully. 
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Pascal P4 on B6700 at Tas 



PASCAL VALIDATION SUITE REPORT 



Pascal Processor Identification: 



Computer: 
Processor: 



Burroughs B6700 

Pascal-P4 compiler received from Sydney, (March 1979) 
updated as described below. 

The Pascal-P4 compiler was compiled with the B6700 Pascal 
version 2.9.001 (university of Tasmania) compiler. 

The Pascal-P4 interpreter was compiled with the B6700 Pascal 
version 2.9.178.008 (UCSD) compiler. 



Test Conditions: 



Tester: CD. Keen 

Date: August 1979 

Validation Suite: Version 2.2 

Details of Update to Compiler 

The original P4 compiler was updated to the level described in the Pascal 
Newsletter, 13 (Dec 1978). 

The compiler and interpreter were both reformatted into 72 character lines. 

The declaration of the file 'PRR' was included in the compiler. 

The maximum length of constant strings, 'STRGLGTH' was increased to 60 
in both the compiler and interpreter. 

The compiler was extended to accept both upper and lower case identifiers, 
with conversion to all upper case characters in 'INSYMBOL'. 

The compiler was extended to recognise the alternative form of comment 
delimiters: ' { ... }' . 

The sizes of the integer, real and set constant tables, and the bounds 
table in the interpreter were extended to 100 words each. 

During the processing of the validation suite the following errors in 
the compiler were corrected: 

a) In the procedure 'GEN2T' the field width of bounds variables was increased. 
Replace: WRITELN(PRR,FP1 :3+0RD(ABS(FPl)>99) *5,FP2 :8) ; 

by: WRITELN(PRR,FP1:14,FP2:14); 

b) The assignment *FSP := LSP 1 near the end of the procedure 'TYP' 
causes an error if 'LSP' is undefined. This can occur if the type 
commences with 'packed' , but does not have the subsequent symbol 
in 'TYPEDELS 1 . 



Replace: ERR0R(10); SKIP(FSYS+TYPEDELS) ; 
by: ERROR(IO); SKIP(FSYS+TYPEDELS) ; LSP 



nil 



c) Fix number 17, proposed by Jim Miner (PN, Feb 1978, p71) to prevent 
comparisons of arrays and records within the procedure 'EXPRESSION' 
can result in 'TYPIND' not being defined. This also prevents 
comparisons of strings. 



Replace: 



by: 

Replace: 
by: 



if not^ STRING(LATTR.TYPTR) 

and (LOP rn [LTOP,LEOP,GTOP,GEOP] ) then 

ERR0R(131); 
ERR0R(134); 

if not^ STRING (LATTR.TYPTR) then ERR0R(134) ; 
TYPIND := 'M f ; 

ERROR(134); 

ERR0R(134); TYPIND := 'M'; 
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d) If the bounds of a for statement are not parsed correctly then the 
name of the label at the commencement of the for statement will not be 
defined. This causes the generation of a jump to this label to crash at: 

... GENUJPXJP( .. ,LADDR); ... 

To ensure that 'LADDR' is defined, even when syntax errors occur in 
'FORSTATEMENT' , insert the following statement at the commencement of 
the body of that procedure: 

LADDR := INTLABEL + 1: 



Conformance Tests: 
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Number of tests passed: 

Number of tests failed: 46 (22 basic causes) 
Details of failed tests : 

Test 6.1.2-3 fails because only the first 8 characters of an identifier 
are significant, and not the identifier's actual length. 

Test 6.1.7-2 fails because the maximum length of strings is restricted. 

Test 6.2.2-3 fails because the domain of a pointer type tT is not permitted 
to have its defining occurrence anywhere in the type-declaration-part in 
which it occurs. 

Test 6.2.2-8 fails because assignment is not permitted to a function 
identifier at a lower level than the level at which the function is 
declared. 

Tests 6.4.2.2-2, 6.7.2.2-5 and 6.8.3.9-7 fail because 'maxint' is not 
predeclared. 

Tests 6.4.3.1-3, 6.4.3.5-1, 6.5.1-1 and 6.5.3.4-1 fail because declarations 
of files are not permitted. 

Test 6.4.3.2-3 fails because the character set differed between the 
compiler and interpreter, so that integer checks on subranges of char 
are invalid. 

Test 6.4.3.3-1 fails because variant parts without tag fields are not 
permitted. 

Test 6.4.3.3-1 fails because a record containing only a semicolon produces 
a syntax error. 
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Tests 6.4.3.5-2, 6.6.3.1-3 and 6.9.4-15 could not be completed because 
'text' is not predeclared. 

Tests 6.4.3.5-3, 6.6.3.1-3, 6.6.5.2-3, 6.6.5.2-4, 6.6.5.2-5, 6.9.1-1, 
6.9.2-1, 6.9.2-2, 6.9.2-3, 6.9.3-1, 6.9.4-1 , 6.9.4-2 , 6.9.4-3, 6.9.4-4, 
6.9.4-6, 6.9.4-7 and 6.9.5-1 could not be completed because 'reset 1 and 
'rewrite' are not implemented. 

Test 6.4.3.5-4 fails because the output line is not flushed at the program's 
completion. This is not explicitly performed by the interpreter, but is 
dependent on the processor used to compile the interpreter. 

Tests 6.6.3.1-5, 6.6.3.4-1, 6.6.3.4-2 and 6.6.3.5-1 could not be completed 
because procedure and function, parameters are not permitted. 

Test 6.6.5.3-2 could not be completed because 'dispose' is not permitted. 

Test 6.6.5.4-1 could not be completed because 'pack' and 'unpack' are not 
implemented. 

Test 6.6.6.3-1 could not be completed because 'round' is not permitted. 

Test 6.8.2.1-1 could not be completed because the implementation of scalar 
types is dependent on the processor which compiled the interpreter, and the 
UCSD B6700 Pascal compiler does not correctly implement operations on 
boolean variables, ( hot is implemented as one's complement) 

Test 6.8.2.4-1 fails because nonlocal goto 's are not permitted. 

Test 6.8.3.5-4 fails because the maximum range of case labe-ls is 1000. (CIXMAX) 

Test 6.8.3.9-1 fails because the assignment to a control variable in a for 
loop precedes the evaluation of the second expression in the for statement. 

Test 6.9.4-7 fails because the writing of boolean variables to text files 
is not implemented. 

Test 6.9.6-1 fails because 'page' is not permitted. 



Deviance Tests 



Number, of deviations correctly detected: 52 

Number of tests showing true extensions: 4 

Number of tests not detecting erroneous deviations: 25 (13 basic causes) 

Number of tests failed: 12 (6 basic causes) 

Details of extensions : 

Tests 6.8.3.9-9, 6.8.3.9-14 and 6.8.3.9-19 show that a for control variable 
can be globally declared. 

Test 6.10-1 shows that file parameters in the program heading are ignored. 
Details of deviations not detected: 



Test 6.1.2-1 shows that 'nil' is a predeclared identifier, rather than a 
reserved word. 

Tests 6.1.7-6 and 6.4.3.2-5 show that the index bounds of a string are not 
restricted to l..n. 

Tests 6.1.7-7 and 6.1.7-8 show that strings are permitted to be an array of a 
subrange of char. 



6.3-6 and 6.4.1-3 show that common scope errors are not 



Tests 6.2.2-4, 
detected. 

Tests 6.3-5 and 6.7.2.2-9 show that a signed string is permitted as a factor. 

Tests 6.4.5-2, 6.4.5-3, 6.4.5-4, 6.4.5-5 and 6.4.5-13 show that type 
compatibility is used with var parameters, rather than enforcing identical 
types. 

Test 6.6.2-5 shows that no check is made to ensure that an assignment to a 
function identifier exists in the code of that function. 

Test 6.6.6.4-6 shows that 'succ' and 'pred' can be applied to real arguments. 

Tests 6.8.2.4-2 and 6.8.2.4-3 show that a goto is permitted between branches 
of an if or case statement. 

Tests 6.8.3.9-2, 6.8.3.9-3 and 6.8.3.9-4 show that an assignment to a for 
control variable is permitted within a loop. 

Test 6.9.4-9 shows that an output field width can be negative. 

Test 6.10-3 shows that 'output' can be redefined at the program level, and 
yet still exist as a file. 

Test 6.10-4 shows that a program heading is not required. 
Details of failed tests: 
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Tests 6.1.7-5 and 6.9.4-12 fail because the reserved word packed is ignored. 

Tests 6.4.6-11 and 6.4.6-12 fail because declarations of files are not 
permitted. 

Test 6.8.3.9-16 fails because 'reset' and 'rewrite' are not implemented. 

Test 6.6.1-6 fails because no check is made to ensure that forward declared 
procedures and functions are actually present. 

Tests 6.6.3.5-2, 6.6.3.6-2, 6.6.3.6-3, 6.6.3.6-4 and 6.6.3.6-5 fail because 
procedure and function parameters are not permitted. 

Test 6.6.6.3-4 fails because 'round' is not permitted. 
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Error Handling 

Number of errors correctly detected: 13 

Number of errors not detected: 33 (16 basic causes) 

Details of errors not detected : 

Test 6.2.1-7 shows that variables are not preset to 'undefined' at 
interpretation time. 

Tests 6.4.3.3-5 and 6.4.3.3-6 indicate that no runtime checks are performed 
on the tag field of variant records. 

Tests 6.4.3.3-7 and 6.4.3.3-8 could not be completed because variant records 
without tag fields are not permitted. 

Tests 6.4.6-7 and 6.4.6-8 show that the determination of compatibility 
between set types is incorrect. 
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Test 6.6.2-6 shows that the use of a function without assignment to the 
function-value-variable is permitted. 

Tests 6.6.5.2-1, 6.6.5.2-2, 6.6.5.2-6, 6.9.2-4 and 6.9.2-5 could not be 
completed because 'reset' and 'rewrite' are not implemented. 

Test 6.6.5.2-7 could not be completed because declarations of files are 
not permitted. 

Tests 6.6.5.3-3., 6.6.5».3-4, 6.6.5.3-5 and 6.6.5.3-6 could not be completed 
because 'dispose' is not permitted. 

Tests 6.6.5.3-7, 6.6.5.3-8 and 6.6.5.3-9 fail because no checks are made on 
pointer variables after they have been assigned a value using the variant 
of 'new' . 

Tests 6.6.6.2-4, 6.6.6.2-5 and 6.7.2.2-3 show that no explicit checks are 
made by the interpreter for invalid arguments to 'alog', 'sqrt', '/', 
div and mod . 

Test 6.6.6.3-2 shows that no check is made to ensure that the result of a call 
to 'trunc' is in the range -maxint. .maxint. 

Test 6.6.6.3-3 could not be completed because 'round' is not permitted. 

Tests 6.7.2.2-6 and 6.7.2.2-7 could not be completed because 'maxint' is 
not predeclared. 

Test 6.7.2.4-1 fails because operations on overlapping sets are not detected. 

Tests 6.8.3.9-5 and 6.8.3.9-6 show that the use of a for control variable 
immediately after the loop termination is not prevented. 

Test 6.8.3.9-17 shows that two nested for statements with the same control 
variable are permitted. 



Implementation defined 

Number of tests run: 15 

Number of tests incorrectly handled: 9 (5 basic causes) 

Details of implementation-dependence : 

Only implementation details fixed in the compiler are considered, and not 
details dependent on the processor which compiled the interpreter. 

Test 6.4.2.2-7 shows that 'maxint' is not predeclared. 

Tests 6.4.3.4-2 and 6.4.3.4-4 show that the maximum permitted range of set 
values is 0..47. This is the minimum required to parse the P4 compiler. 

Test 6.6.6.1-1 could not be completed because procedure and function 
parameters are not permitted. 

Tests 6.7.2.3-2 and 6.7.2.3-3 show that boolean expressions are fully 
evaluated. 

Tests 6.8.2.2-1 and 6.8.2.2-2 show that a variable is selected before the 
expression is evaluated in an assignment statement. 

Tests 6.9.4-5, 6.9.4-11 and 6.10-2 could not be completed because 'reset' 

and 'rewrite' are not implemented. The default field width specifications 

are: 10 for integers, 20 for reals (floating point notation only) and 
1 for characters. 

Tests 6.11-1, 6.11-2 and 6.11-3 show that no alternative symbols have been 
implemented. 



Quality Measurement 

Number of tests run: 23 

Number of tests incorrectly handled: 11 
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Results of tests: 
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Test 5.2.2-1 shows that only the first 8 characters of an identifier are 
significant. 

Test 6.1.8-4 shows that no warning is given of semicolons within comments. 

Tests 6.2.1-8, 6.2.1-9 and 6.5.1-2 indicate that long lists of declarations 
can be made in each block, depending on the maximum extent of the heap in 
the compiler. 

Test 6.4.3.2-4 shows that an array with 'integer' index type is not permitted. 

Test 6.4.3.3-9 shows that variant fields of a record occupy the same space, 
using 'reverse correlation'. 

Test 6.4.3.4-5 (Warshall's algorithm) took 172.530 seconds CPU interpretation 
time. (cf. 10.498 seconds CPU execution with UCSD B6700 compiler) 

Test 6.6. 1-7 "shows that the maximum depth of procedure nesting is 10. (MAXLEVEL) 

Tests 6.6.6.2-6, 6.6.6.2-7, 6.6.6.2-8, 6.6.6.2-9, 6.6.6.2-10 and 6.7.2.2-4 
are only relevant to the implementation of ' sqrt ', 'atan' , *exp' ,' sin* ,' cos' , 
'In', div and mod in the processor which compiled the interpreter. 

Test 6.8.3.5-2 shows that case constants must be compatible with the case 
index, but do not have to be of the same type if the case index is a subrange. 



Test 6.8.3.5-8 shows that a large case statement is permitted. 

Test 6.8.3.9-18 shows that a range check is performed in a case statement 
after a for statement to check the value of the for control variable. 

Test 6.8.3.9-20 and 6.8.3.10-7 show that for and with statements can be 
nested to a depth exceeding 15. 

Test 6.9.4-10 shows that the flushing of the output line buffer depends on 
the processor which compiled the interpreter. 

Test 6.9.4-14 shows that recursive I/O is permitted, using the same file. 
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Ext ension s 

Number of tests run: 1 
Details of test : 

Test 6.8.3.5-14 shows that no extensions have been made to the standard 
syntax of the case statement. 
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POLICY: PASCAL USER'S GROUP (79/09/01) 

Purposes: Pascal User's Group (PUG) tries to promote the use of the programming 
language Pascal as well as the ideas behind Pascal through the vehicle 
of Pascal News . PUG is intentionally designed to be non-political, and 
as such, it is not an "entity" which can take stands on issues or 
support causes or other efforts however well-intentioned. Informality 
is our guiding principle; there are no officers or meetings of PUG. 

The increasing availability of Pascal makes it a viable alternative for 
software production and justifies its further use. We all strive to 
make using Pascal a respectable activity. 

Membership: Anyone can join PUG: particularly the Pascal user, teacher, maintainer, 
implementor, distributor, or just plain fan. Memberships from libraries 
are also encouraged. 

See the ALL-PURPOSE COUPON for details. 

FACTS ABOUT Pascal, THE PROGRAMMING LANGUAGE: 

Pascal is a small , practical , and general purpose (but not all-purpose ) 
programming language possessing algorithmic and data structures to aid 
systematic programming. Pascal was intended to be easy to learn and 
read by humans, and efficient to translate by computers. 

Pascal has met these design goals and is being used quite widely and 
successfully for: 

* teaching programming concepts 

* developing reliable "production" software 

* implementing software efficiently on today's machines 

* writing portable software 

Pascal is a leading language in computer science today and is being 
used increasingly in the world's computing industry to save energy and 
resources and increase productivity. 

Pascal implementations exist for more than 62 different computer systems, 
and the number increases every month. The Implementation Notes section 
of Pascal News describes how to obtain them. 

The standard reference and tutorial manual for Pascal is: 

Pascal - User Manual and Report (Second, study edition) 
by Kathleen Jensen and Niklaus Wirth 

Springer-Verlag Publishers: New York, Heidelberg, Berlin 
1978 (corrected printing), 167 pages, paperback, $7.90. 

Introductory textbooks about Pascal are described in the Here and There 
Books section of Pascal News . 

The programming language Pascal was named after the mathematician and 
religious fanatic Blaise Pascal (1623-1662). Pascal is not an acronym. 

Pascal User's Group is each individual member's group. We currently have more than 
3357 active members in more than 41 countries. This year Pascal News is 
averaging more than 120 pages per issue. 
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